TOS Silver 2000

home *** CD-ROM | disk | FTP | other *** search

/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / MAC_PRGS.M2 / GEP_ED.M < prev next >

Wrap

Text File | 1995-11-23 | 159.6 KB | 3 lines

⓪ ⓪ (* Atari-Editor⓪!*------------------------------------------------------------------------------⓪!* Copyright 1986-1995 by Thomas Tempelmann⓪!*------------------------------------------------------------------------------⓪!* TT: Thomas Tempelmann, Schusterwolfstr.13, 81241 München, Tel.089/8347394⓪!* Hü: Wilfried Hübner, Hohenzollernstr. 8B, D-1000 Berlin 39⓪!* HSK: Hannes Krohn, Kreuzstr. 35, Karlsruhe⓪!* MS: Meinolf Schneider⓪!*------------------------------------------------------------------------------⓪!* 0.0: H.-J. Himmeröder :23.02.85: Grundversion⓪!* 1.0: TT :27.06.86: Übernahme des Gepard-Editors 2.p⓪!* 1.1: TT :27.07.86: Load/Save impl.⓪!* 1.2: TT :06.09.86: Cleantext schneller, Aufruf nach Load/Save⓪!* 1.3: TT :23.10.86: Infoblock in Kommentarzeile; Saveinfo nur,⓪!* wenn er beim Laden schon da war.⓪!* 1.4: TT :25.10.86: Tabs werden richtig erkannt (-> "§")⓪!* 1.5: TT :27.10.86: Hoffentlich kein Addr-Err mehr bei save⓪!* 1.6: TT :02.03.87: Zeilennummern nun +1; Bei Frames wird⓪!* 'saveInfo' gerettet; C(op F(ile raus;⓪!* HardCopy korrig.; Cursor wird bei Pos-⓪!* übergabe in ArgV[2] positioniert.⓪!* 1.7: TT :03.03.87: Quit: X und C, TextPos vor CleanText gesetzt⓪!* 1.8: TT :04.03.87: CleanText jetzt endlich richtig; F7/F8.⓪!* 1.9: TT :09.05.87: Save erkennt Disk full⓪!* 2.0: TT :25.07.87: Umstellung als MOS-Modul⓪!* 2.1: TT :29.08.87: Nach Q, S, Return kein extra Zeichen am Textende⓪!* 2.2: TT :14.09.87: FileSearch immer⓪!* 2.3: TT :04.11.87: Code-Optimierungen⓪!* 2.4: TT :25.12.87: ArgV-Auswertung erneuert⓪!* 2.5: TT :25.01.88: In ArgV[3] wird die Spalte jetzt 0-based erwartet⓪!* 2.6: TT :11.04.88: Läuft auch in Farbe.⓪!* 2.6: TT :13.04.88: Farben werden gerettet.⓪!* 2.7: TT :15.04.88: VOR Scrn-Rückschaltung wird auf VBL gewartet.⓪!* 2.8: TT :18.04.88: Startup-Msg geändert, TextName wird auch bei QN gesetzt.⓪!* 2.9: TT :02.06.88: Cleantext erkennt overflow; SaveText löscht File, wenn⓪!* Schreibfehler; Compiler wird mit F5 gestartet - Achtung:⓪!* Wenn Fehler in Include-File, wird der Text nicht geladen⓪!* DLEChar v. $E auf $10 korrigiert.⓪!* 2.A: TT :24.07.88: GotoLine hängt nicht, wenn Zeile = 0.⓪!* 2.B: TT :10.08.88: Ausgabe beschleunigt; Farb-Auswahl nun ok; InsKey/DelKey⓪!* alternativ für Insert-/Delete-Modus; Tabs werden bei F3⓪!* initialisiert.⓪!* 16.08.88: Ctrl-left/right f. SOLn/EOLn⓪!* 2.C 10.09.88: Farbausgabe: ClearEndOfLine korrigiert⓪!* 2.C+ Hü :16.04.89: FileSelectBox (readOnly) eingebaut. Textcursor kann mit⓪!* Maus versetzt werden. Scrolling durch Mausbetätigung⓪!* an den vertikalen Bildschirmrändern.⓪!* 2.D TT 19.04.89: FileSelect-Box auch bei Schreiboperationen; Pfadname⓪!* in FS enthält auch Laufwerksbuchstabe; SaveText liefert⓪!* FALSE bei Schreibfehler -> Text geht nicht mehr bei 'QU'⓪!* verloren; CmdLineAway prüft auch Mausklick; '.TXT' wird⓪!* nicht mehr automatisch angefügt; Tab-Weite kann in⓪!* 'ET' bestimmt werden; Quick-Save-Option; Backup-Name⓪!* wird richtig gebildet; Ctrl-Z bei Save zw. Textende und⓪!* Info-Line.⓪!* 2.E TT 23.04.89: GetPath fügt ggf. '\' an Pfad an, damit es keine Probleme⓪!* mit altem Directories-Modul gibt; FileSelect zeigt Frage⓪!* an; Mauskontrolle überarbeitet (WaitForKey); kein Absturz⓪!* wenn 'Overflow' in GetFile; Nach L(ook kann mit J(ump -⓪!* an Ursprungsstelle zurückgesprungen werden; Kein Hänger⓪!* bei Delete über Textanfang/-ende; TabLeft jetzt mit⓪!* Ctrl- oder Shift-Tab; ScrollUp/Down mit Ctrl-Up/Down;⓪!* Hardcopy wieder drin.⓪!* TT 28.04.89: Bei F3 wird neue Frame-Nr wieder aktualisiert⓪!* 2.F TT 14.05.89: Wenn von niedriger auf mittl. Auflösung umgeschaltet⓪!* werden muß, wird kein GEM (Maus, FileSelect) verwendet⓪!* TT 22.05.89: Kein Hänger, wenn Ctrl-Z erstes Zeichen im Text⓪!* 2.G TT 25.05.89: Ctrl-Z wird nicht am Textende erzeugt, wenn kein⓪!* <Save Info-line>.⓪!* 2.H HSK 13.11.88: Mit F6 wird in .DEF-Files nach dem Identifier unter dem⓪!* Cursor gesucht, das entsprechende .D-File geladen und⓪!* der Cursor auf den Identifier positioniert.⓪!* Mit 'FindWord' wird der vollst. Name gesucht, sonst nach⓪!* dessen Anfang.⓪!* TT 09.07.89: Laden eines leeren Textes gibt keinen Absturz mehr.⓪!* Leereingabe mit [ OK ] bei Fileselect sucht nicht mehr.⓪!* Dateifehler als Text (bisher Nr).⓪!* 2.I TT 17.07.89: F6 geht auch bei M2LIB.DEF⓪!* 2.J TT 25.07.89: CallCompiler übergibt neue Options f. Compiler 3.6p⓪!* TT 06.08.89: Enter-Taste nun direction-unabhängig (immer runter);⓪!* Compiler-Name nun 'MM2Comp'⓪!* 2.H TT 08.08.89: Datum der Source wird ggf. nach Comp-Aufruf neu gesetzt;⓪!* Maus-Kontrolle geändert, damit bei FormAlert die Maus⓪!* sichtbar ist.⓪!* TT 10.08.89: "Save editor info-line" defaultmäßig nun auf FALSE;⓪!* 'ß' wird auch als Alpha-Zeichen erkannt.⓪!* TT 15.08.89: Maus-Kontrolle nochmals geändert (TRUE bei ShowCursor)⓪!* TT 19.08.89: DefLibName importiert, wird nicht mehr gesucht⓪!* TT 20.08.89: Quit mit Make, Make-Exec⓪!* 2.I TT 13.09.89: F6 sollte nun auch mit LibFiles gehen⓪!* 2.J TT 14.12.89: Änderungen an Shortkeys⓪!* TT 11.01.90: F6 findet nun alle Items, auch Rec-Felder & Enum-Elems;⓪!* Environment: X setzt Cursor immer an Textbeginn⓪!* TT 17.01.90: Compilername wird aus ShellMsg importiert⓪!* 2.K TT 13.03.90: Bei Enlarge-Fehler hoffentlich kein Bus-Error mehr⓪!* TT 09.05.90: F6 sucht bei Modulnamen nicht mehr weiter im gefundenen⓪!* Source; CompV4-Anpassung; F6 benutzt 'ReplaceHome'.⓪!* 2.L TT 15.07.90: Enlarge wird nun korrekt aufgerufen.⓪!* 2.M TT 20.08.90: Sollte nun bei Autoswitch-Overscan auf normal schalten;⓪!* MoveText und Find/Replace schneller.⓪!* 2.N TT 15.09.90: Mögl. Buserrors bei FindDefFile abgefangen. F6 kommt⓪!* wieder mit Records klar.⓪!* 2.O TT 18.09.90: Overscan-Switch korrigiert.⓪!* 2.P TT 09.10.90: Läuft auch mit TT⓪!* 2.Q TT 14.11.90: FileSelector wird versuchsweise auch bei Auflösungs-⓪!* wechsel bei ST & TT verwendet (s. InitScreen).⓪!* 2.R TT 03.12.90: Return-Taste wieder Direction-abhängig (a.Adjust,Delete).⓪!* TT 11.12.90: Bei leerem Dateinamen beim Start kommt keine Fehlermeld.⓪!* TT 19.04.91: Erkennt auch einzelne LF als Zeilentrenner⓪!* 2.S TT 20.10.91: Bei DelMode mit Return-Taste und Direction=up kein⓪!* Hänger mehr bei oberster Zeile.⓪!* TT 15.02.93: Der Puffer belegt nur noch 2/3 des freien MaxMem,⓪!* mind. jedoch 32K. StopEditor: erst Screenmode zurück,⓪!* dann ExitGem (damit Redraw bei MultiTOS klappt?).⓪!* MenuBar(NIL) vor InitEditor.⓪!* 2.T TT 21.11.93: SetScreen-Aufruf ("Setrez") am Ende nur, wenn's auch am⓪!* Anfang aufgerufen wurde (Vorschlag v. G.Castan wg. STE).⓪!* MouseControl-Aufruf zu Beginn wg. MultiTOS.⓪!* Tastenabfrage per MultiEvent.⓪!* 2.T TT 10.12.93: GetInfo: Falls kein DLE im 1. Byte des Textes, wird auch⓪!* die Info am Ende verworfen (wg. D.Steins Editor)⓪!* 11.01.94: Maus wird nur noch über GrafMouse ein-/ausgeschaltet.⓪!* 17.01.94: Bei neuen Texten wird im tag "=" ptrEnd gespeichert. Dies⓪!* wird von nun an als Kriterium benutzt, ob die Infoline⓪!* gültig ist. Über tag[';'] wird Cursorpos. beim Speichern⓪!* gemerkt und beim Laden sofort wieder angesprungen.⓪!* 2.U TT 06.02.94: Shift-/Ctrl-Cursor vertauscht.⓪!* TT 24.10.94: rowBytes-Verwendung eingebaut für Mac. Z.Zt. noch #832!⓪!* TT 08.12.94: rowBytes werden nun über LineA ermittelt. "isMac"-Flag⓪!* ist jetzt zwar gesetzt, wird aber noch nicht überall⓪!* ausgewertet -> Editor noch nicht auf normalen Ataris⓪!* lauffähig!⓪!* MS 20.01.95: Fehler mit rowbytes und Auflösungsänderung behoben,⓪!* beliebige Anzahl Zeilen sind jetzt möglich.⓪!* TT 02.02.95: Maus aus bei Mac, rowBytes-Korrekturen v. MS, Farbrücksetzung⓪!* bei Quit.⓪!*)⓪ ⓪ ⓪ MODULE GEP_ED; (*$C-,R-,Q+,M-,G+ (Dezimale Char-Konst.) *)⓪ ⓪ (* ED1.ICL *)⓪ FROM EasyGEM0 IMPORT ForceDeskRedraw;⓪ FROM GrafBase IMPORT Point, Rectangle;⓪ FROM GEMGlobals IMPORT TEffectSet, msbut1, MbuttonSet, TextEffect,⓪0GemChar, FillType, SpecialKeySet, Root;⓪ FROM AESEvents IMPORT MultiEvent, lookForEntry, Event, EventSet, MessageBuffer;⓪ FROM AESGraphics IMPORT MouseForm, GrafMouse;⓪ FROM VDIInputs IMPORT GetMouseState;⓪ FROM AESMenus IMPORT MenuBar;⓪ FROM AESWindows IMPORT MouseControl, UpdateWindow, SetNewDesk;⓪ FROM GEMEnv IMPORT RC, DeviceHandle, GemHandle, InitGem,⓪(GEMVersion, ExitGem, CurrGemHandle;⓪ FROM Strings IMPORT Empty, Append, Concat, Upper, Pos, Delete, Assign,⓪(Compare, equal, Insert, PosLen, Length;⓪ IMPORT Strings;⓪ FROM StrConv IMPORT CardToStr, LHexToStr, StrToLCard, StrToCard, IntToStr;⓪ FROM Storage IMPORT Enlarge, ALLOCATE, DEALLOCATE, Inconsistent,⓪+MemAvail, MemSize, AllAvail;⓪ FROM StorBase IMPORT FullStorBaseAccess;⓪ FROM ArgCV IMPORT InitArgCV, PtrArgStr;⓪ FROM PrgCtrl IMPORT TermProcess;⓪ FROM PathEnv IMPORT FileSelectProc, SelectFile, NoSelect, ReplaceHome,⓪+HomeReplaced, HomePath;⓪ FROM PathCtrl IMPORT PathList, PathEntry;⓪ FROM Paths IMPORT ListPos, SearchFile;⓪ FROM ShellMsg IMPORT SrcPaths, TextName, ErrorMsg, TextCol, TextLine, ScanMode,⓪(MainOutputPath, DefLibName, CodeName, CodeSize, Active, DefPaths,⓪(StdPaths, ShellPath, CompilerArgs, CompilerParm, DefSfx;⓪ FROM Files IMPORT File, Access, ReplaceMode, Open, Create, Close,⓪(GetDateTime, SetDateTime, State, GetStateMsg, ResetState;⓪ FROM Binary IMPORT ReadBytes, FileSize, WriteBytes, Seek, fromBegin;⓪ FROM LibFiles IMPORT LibFile, OpenLib, CloseLib, LibQuery, LibEntry;⓪ FROM FileNames IMPORT SplitName, SplitPath, ConcatPath;⓪ IMPORT FileNames;⓪ FROM Directory IMPORT DirEntry, DirQuery, MakeFullPath, GetDefaultPath,⓪(FileAttrSet;⓪ FROM Lists IMPORT NextEntry, ResetList, InitList, List;⓪ FROM Clock IMPORT CurrentDate, CurrentTime, PackDate, PackTime,⓪(Date, Time, UnpackDate, UnpackTime;⓪ IMPORT CookieJar, LineA;⓪ FROM TimeConvert IMPORT DateToText, TimeToText;⓪ IMPORT Block;⓪ FROM EasyExceptions IMPORT Call, Exception;⓪ ⓪ FROM Loader IMPORT DefaultStackSize, CallModule, LoaderResults;⓪ ⓪ CONST mayCallCompiler = TRUE; (* Bei FALSE auch Loader-IMPORT entfernen! *)⓪ ⓪ TYPE ASCII = SET OF [0C..255C];⓪ ⓪ CONST intVersion = 'V#0705';⓪(Version = '2.V';⓪ ⓪(infoLen = 624;⓪(⓪(DLEoffset = $20;⓪(DLEchar = 16C;⓪(⓪(ToggleTabKey = 02C;⓪(ETXKey = 03C;⓪(EnterKey = 13C;⓪(DELKey = 05C;⓪(BSKey = 04C;⓪(INSKey = 01C;⓪(LeftKey = 06C;⓪(RightKey = 07C;⓪(WordLeftKey = 08C;⓪(WordRightKey = 09C;⓪(EoLnKey = 18C;⓪(SoLnKey = 19C;⓪(TabLeftKey = 10C;⓪(TabRightKey = 11C;⓪(UpKey = 14C;⓪(DownKey = 15C;⓪(PageUpKey = 16C;⓪(PageDownKey = 17C;⓪(ClrEoLnKey = 20C;⓪(ClrLnKey = 21C;⓪(FindDefKey = 22C;⓪(ESCKey = 27C;⓪(BreakKey = 'B';⓪(HelpKey = 24C;⓪(OpenFrameKey = 25C;⓪(CloseFrameKey= 26C;⓪(HomeKey = 28C;⓪(ScrlUpKey = 29C;⓪(ScrlDownKey = 30C;⓪(CompileKey = 31C;⓪ ⓪(CRChar = 13C;⓪(LFChar = 10C;⓪(BSChar = 08C;⓪(ClrScrnChar = 12C;⓪(ClrEolnChar = 01C;⓪(ClrEoSChar = 02C;⓪(Cursoronchar = 03C;⓪(Cursoroffchar = 04C;⓪(Inverseonchar = 05C;⓪(Inverseoffchar = 06C;⓪(LeftChar = 11C;⓪(HomeChar = 14C;⓪(ClrLnChar = 15C;⓪(DownChar = 17C;⓪(UpChar = 18C;⓪ ⓪ TYPE String = ARRAY [0..81] OF CHAR;⓪%MaxStr = ARRAY [0..255] OF CHAR;⓪ ⓪ VAR fileName, errMsg, Path1, FName1,⓪$oldString, newString : String;⓪$printLine (* Puffer für Ausgaberoutinen *) : MaxStr;⓪$exitCode, LinesPerChar, PointsPerChar : INTEGER;⓪$maxLine, maxCol, maxColM1, yx, dleWert, ptrXIns, nrOfTabs,⓪$ptrY, ptrX, ptrLine, ptrCount, workCount, countDefault,dumCard,⓪$fileD, fileT, filesInMem, sessions, oldShiftMode, rowBytes,⓪$ErrorNr, CursorX, CursorY, cols, Lines, cmdMode : CARDINAL;⓪$bufferStart, bufferH, bufferL, bufferM, ptrStart, ptr, temp,⓪$ptrEnd, delPtr, lastPtr, hilf, scrPtr, pFont8_8, pFont8_16,⓪$oldSelect, pScreen, ShortKeyPtr, ColorReg : ADDRESS;⓪$oldDepth,⓪$rptf , total, startupTime, keepTime, ErrorPos, flen, ErrLine : LONGCARD;⓪$direction, findCase, findSame, findWord, verify, endOfEd, color,⓪$isMac, saved, cmdFlag, infinite, abort, accept, delFlag, insFlag,⓪$success, forceTab, screenOK, fnOK, makeDLE, autoBack, autoIncVer,⓪$strOK,Ok1, CursorState, tabMode, Inverse, Inserting, saveInfo,⓪$UseGem, rez_changed, UseMouse, defFound, leaveDLEonWrite,⓪$restoreFileDT, modNameFound, isTT : BOOLEAN;⓪$oldconterm, ch : CHAR;⓪$tabs: ARRAY [0..40] OF WORD;⓪$oldColor: ARRAY [0..3] OF CARDINAL;⓪$DefLibFile: LibFile;⓪$f: File;⓪$IOResult,Integ : INTEGER;⓪$allowed : ASCII;⓪$infoBuffer : ARRAY [1..330] OF word;⓪$fontbuffer : ARRAY [0..$7FF] OF WORD; (* 4 KB für akt. Font *)⓪$dev : DeviceHandle;⓪$hdl : GemHandle;⓪$NoOfGraphicLines, NoOfTextRows, NoOfTextLines, HeightOfTextLine : CARDINAL;⓪$⓪$(* folg. 5 Vars müssen hintereinander liegen! *)⓪$ptrStack : ARRAY [0..15] OF ADDRESS; tags: ARRAY ['0'..'Z'] OF ADDRESS;⓪$saveStack : ARRAY [0..15] OF ADDRESS; svs2: ARRAY ['0'..'Z'] OF ADDRESS;⓪$svlptr: ADDRESS;⓪ ⓪ ⓪ (* TABLE.B ErrorType: 'wwwcccpnpkrrcoooP'; *)⓪ ⓪ ⓪ (* ED2.ICL *)⓪ ⓪ (*$l-*)⓪ PROCEDURE DispChar;⓪ BEGIN⓪ ASSEMBLER⓪ ;⓪ ; *** Character auf Monitor-Screen darstellen ***⓪ ; Char in D0.B⓪ ; (D0/A0/A1)⓪ ;⓪*TST.W color⓪*BNE disp8x8⓪*⓪*; Font-^ auf richtiges Zeichen bestimmen:⓪*LEA fontbuffer,A0⓪*LSL #4,D0 ; * 16⓪*ADDA.W D0,A0⓪ (*⓪*; Screenoffset := CursorY * 80 * 16 + CursorX * 1⓪*MOVE.W CursorY,D0⓪*; D0 * 1280⓪*LSL.W #8,D0⓪*MOVE.L D0,A1⓪*LSL.W #2,D0⓪*ADD.W A1,D0⓪*ADD CursorX,D0⓪*MOVE.L pScreen,A1⓪*ADDA.W D0,A1⓪*⓪*MOVE.B (A0)+,(A1)⓪*MOVE.B (A0)+,0080(A1)⓪*MOVE.B (A0)+,0160(A1)⓪*MOVE.B (A0)+,0240(A1)⓪*MOVE.B (A0)+,0320(A1)⓪*MOVE.B (A0)+,0400(A1)⓪*MOVE.B (A0)+,0480(A1)⓪*MOVE.B (A0)+,0560(A1)⓪*MOVE.B (A0)+,0640(A1)⓪*MOVE.B (A0)+,0720(A1)⓪*MOVE.B (A0)+,0800(A1)⓪*MOVE.B (A0)+,0880(A1)⓪*MOVE.B (A0)+,0960(A1)⓪*MOVE.B (A0)+,1040(A1)⓪*MOVE.B (A0)+,1120(A1)⓪*MOVE.B (A0)+,1200(A1)⓪*RTS⓪ *)⓪ ⓪*MOVE.W CursorY,D0⓪*LSL.W #4,D0 ; * 16⓪*MULU rowBytes,D0⓪*MOVE CursorX,A1⓪*ADD.L A1,D0⓪*MOVE.L pScreen,A1⓪*ADDA.L D0,A1⓪*⓪*MOVE.L A1,-(A7)⓪*MOVEQ #16-1,D0⓪ ll: MOVE.B (A0)+,(A1)⓪*;ADDA.W #832,A1⓪*adda.w rowbytes,A1⓪*DBRA D0,ll⓪*MOVE.L (A7)+,A1⓪*RTS⓪ ⓪ disp8x8 ; Font-^ auf richtiges Zeichen bestimmen:⓪*MOVEM.W D4/D5,-(A7)⓪*LEA fontbuffer,A0⓪*LSL #3,D0 ; * 8⓪*ADDA.W D0,A0⓪*; Screenoffset := CursorY * 80/160 * 8/16 + CursorX * 1/2⓪*MOVE.W CursorY,D0⓪*; D0 * 1280⓪*LSL.W #8,D0⓪*MOVE D0,D4⓪*LSL.W #2,D0⓪*ADD.W D4,D0⓪*MOVE CursorX,D4⓪*MOVE D4,D5⓪*ANDI #$FFFE,D4⓪*LSL #1,D4⓪*ADD D4,D0⓪*ANDI #1,D5⓪*ADD D5,D0⓪*MOVE.L pScreen,A1⓪*ADDA.W D0,A1⓪*MOVEM.W (A7)+,D4/D5⓪*⓪*; beide Planes müssen gesetzt werden⓪*MOVE.B (A0) ,(A1)⓪*MOVE.B (A0)+,0002(A1)⓪*MOVE.B (A0) ,0160(A1)⓪*MOVE.B (A0)+,0162(A1)⓪*MOVE.B (A0) ,0320(A1)⓪*MOVE.B (A0)+,0322(A1)⓪*MOVE.B (A0) ,0480(A1)⓪*MOVE.B (A0)+,0482(A1)⓪*MOVE.B (A0) ,0640(A1)⓪*MOVE.B (A0)+,0642(A1)⓪*MOVE.B (A0) ,0800(A1)⓪*MOVE.B (A0)+,0802(A1)⓪*MOVE.B (A0) ,0960(A1)⓪*MOVE.B (A0)+,0962(A1)⓪*MOVE.B (A0) ,1120(A1)⓪*MOVE.B (A0)+,1122(A1)⓪ END⓪ END DispChar;⓪ ⓪ (*$l-*)⓪ PROCEDURE NextCharMono;⓪ BEGIN⓪ ASSEMBLER⓪(; Font-^ auf richtiges Zeichen bestimmen:⓪(LEA fontbuffer,A0⓪(LSL #4,D0 ; * 16⓪(ADDA.W D0,A0⓪(ADDQ.L #1,A1⓪ ⓪*MOVE.L A1,-(A7)⓪*MOVEQ #16-1,D0⓪ ll: MOVE.B (A0)+,(A1)⓪*;ADDA.W #832,A1⓪*adda.w rowbytes,A1⓪*DBRA D0,ll⓪*MOVE.L (A7)+,A1⓪ (*⓪(MOVE.B (A0)+,(A1)⓪(MOVE.B (A0)+,0080(A1)⓪(MOVE.B (A0)+,0160(A1)⓪(MOVE.B (A0)+,0240(A1)⓪(MOVE.B (A0)+,0320(A1)⓪(MOVE.B (A0)+,0400(A1)⓪(MOVE.B (A0)+,0480(A1)⓪(MOVE.B (A0)+,0560(A1)⓪(MOVE.B (A0)+,0640(A1)⓪(MOVE.B (A0)+,0720(A1)⓪(MOVE.B (A0)+,0800(A1)⓪(MOVE.B (A0)+,0880(A1)⓪(MOVE.B (A0)+,0960(A1)⓪(MOVE.B (A0)+,1040(A1)⓪(MOVE.B (A0)+,1120(A1)⓪(MOVE.B (A0)+,1200(A1)⓪ *)⓪ END⓪ END NextCharMono;⓪ ⓪ (*$l-*)⓪ PROCEDURE NextCharColor;⓪ BEGIN⓪ ASSEMBLER⓪(; Font-^ auf richtiges Zeichen bestimmen:⓪(LEA fontbuffer,A0⓪(LSL #3,D0 ; * 8⓪(ADDA.W D0,A0⓪(MOVE.W A1,D0⓪(BTST #0,D0⓪(BEQ even⓪(ADDQ.L #3,A1⓪(BRA odd0⓪ even ADDQ.L #1,A1⓪ odd0 MOVE.B (A0) ,(A1)⓪(MOVE.B (A0)+,0002(A1)⓪(MOVE.B (A0) ,0160(A1)⓪(MOVE.B (A0)+,0162(A1)⓪(MOVE.B (A0) ,0320(A1)⓪(MOVE.B (A0)+,0322(A1)⓪(MOVE.B (A0) ,0480(A1)⓪(MOVE.B (A0)+,0482(A1)⓪(MOVE.B (A0) ,0640(A1)⓪(MOVE.B (A0)+,0642(A1)⓪(MOVE.B (A0) ,0800(A1)⓪(MOVE.B (A0)+,0802(A1)⓪(MOVE.B (A0) ,0960(A1)⓪(MOVE.B (A0)+,0962(A1)⓪(MOVE.B (A0) ,1120(A1)⓪(MOVE.B (A0)+,1122(A1)⓪ END⓪ END NextCharColor;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE InvertChar;⓪ BEGIN⓪ ASSEMBLER⓪ ;⓪ ; *** Character auf Monitor-Screen invertieren ***⓪ ; (D0/A0)⓪ ;⓪*TST.W color⓪*BNE disp8x8⓪ (*⓪*MOVE.W CursorY,D0⓪*LSL.W #8,D0⓪*MOVE.L D0,A0⓪*LSL.W #2,D0⓪*ADD.W A0,D0⓪*ADD CursorX,D0⓪*MOVE.L pScreen,A0⓪*ADDA.W D0,A0⓪*MOVEQ #-1,D0⓪*EOR.B D0,(A0)⓪*EOR.B D0,0080(A0)⓪*EOR.B D0,0160(A0)⓪*EOR.B D0,0240(A0)⓪*EOR.B D0,0320(A0)⓪*EOR.B D0,0400(A0)⓪*EOR.B D0,0480(A0)⓪*EOR.B D0,0560(A0)⓪*EOR.B D0,0640(A0)⓪*EOR.B D0,0720(A0)⓪*EOR.B D0,0800(A0)⓪*EOR.B D0,0880(A0)⓪*EOR.B D0,0960(A0)⓪*EOR.B D0,1040(A0)⓪*EOR.B D0,1120(A0)⓪*EOR.B D0,1200(A0)⓪*RTS⓪ *)⓪*MOVE.W CursorY,D0⓪*LSL.W #4,D0 ; * 16⓪*MULU rowBytes,D0⓪*MOVE CursorX,A0⓪*ADD.L A0,D0⓪*MOVE.L pScreen,A0⓪*ADDA.L D0,A0⓪*⓪*MOVEQ #16-1,D0⓪ ll: EORI.B #$FF,(A0)⓪*;ADDA.W #832,A0⓪*adda.w rowbytes,A0⓪*DBRA D0,ll⓪*RTS⓪ ⓪ disp8x8 MOVEM.W D4/D5,-(A7)⓪*; Screenoffset := CursorY * 80/160 * 8/16 + CursorX * 1/2⓪*MOVE.W CursorY,D0⓪*; D0 * 1280⓪*LSL.W #8,D0⓪*MOVE D0,D4⓪*LSL.W #2,D0⓪*ADD.W D4,D0⓪*MOVE CursorX,D4⓪*MOVE D4,D5⓪*ANDI #$FFFE,D4⓪*LSL #1,D4⓪*ADD D4,D0⓪*ANDI #1,D5⓪*ADD D5,D0⓪*MOVE.L pScreen,A0⓪*ADDA.W D0,A0⓪*MOVEM.W (A7)+,D4/D5⓪*MOVEQ #-1,D0⓪*EOR.B D0,(A0)⓪*EOR.B D0,0002(A0)⓪*EOR.B D0,0160(A0)⓪*EOR.B D0,0162(A0)⓪*EOR.B D0,0320(A0)⓪*EOR.B D0,0322(A0)⓪*EOR.B D0,0480(A0)⓪*EOR.B D0,0482(A0)⓪*EOR.B D0,0640(A0)⓪*EOR.B D0,0642(A0)⓪*EOR.B D0,0800(A0)⓪*EOR.B D0,0802(A0)⓪*EOR.B D0,0960(A0)⓪*EOR.B D0,0962(A0)⓪*EOR.B D0,1120(A0)⓪*EOR.B D0,1122(A0)⓪ END⓪ END InvertChar;⓪ ⓪ (*$l-*)⓪ PROCEDURE ScrnCurOff;⓪ BEGIN⓪ ASSEMBLER⓪(; CLR.L CursorCnt⓪(TST CursorState⓪(BEQ CurOffE⓪(JSR InvertChar⓪(CLR CursorState⓪ CurOffE⓪ END;⓪ END ScrnCurOff;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE BufferDisp;⓪ BEGIN⓪ ASSEMBLER⓪(DBRA D3,cont0⓪(RTS⓪ cont0 JSR ScrnCurOff⓪(CLR D0⓪(TST.W color⓪(BEQ mono⓪(BRA col⓪ ⓪ mono2: CLR D0⓪(MOVE.B (A2)+,D0⓪(JSR NextCharMono⓪(ADDQ.W #1,CursorX⓪(DBRA D3,mono2⓪(RTS⓪ mono MOVE.B (A2)+,D0⓪(JSR DispChar⓪(ADDQ.W #1,CursorX⓪(DBRA D3,mono2⓪(RTS⓪ ⓪ ⓪ color2 CLR D0⓪(MOVE.B (A2)+,D0⓪(JSR NextCharColor⓪(ADDQ.W #1,CursorX⓪(DBRA D3,color2⓪(RTS⓪ col MOVE.B (A2)+,D0⓪(JSR DispChar⓪(ADDQ.W #1,CursorX⓪(DBRA D3,color2⓪ END⓪ END BufferDisp;⓪ ⓪ (*$L-*)⓪ PROCEDURE ClearEndOfLine;⓪ BEGIN⓪ ASSEMBLER⓪(MOVE CursorX,D0⓪(BTST #0,D0⓪(BEQ clreol⓪(MOVEQ #' ',D0⓪(JSR DispChar⓪(ADDQ #1,CursorX⓪(BSR clreol⓪(SUBQ #1,CursorX⓪ ClEolE0 RTS⓪ ⓪ clreol TST.W color⓪(BNE disp8x8⓪ ⓪(MOVE cols,D0 ; 80⓪(SUB CursorX,D0 ; ergibt gerade Anzahl zu löschender Bytes⓪(BLS ClEolE0⓪(LSR #1,D0 ; Anzahl Words⓪(SUBQ #1,D0⓪(MOVE D1,-(A7)⓪(MOVE.L D2,-(A7)⓪(MOVE D0,-(A7)⓪(MOVE.W CursorY,D0⓪ (*⓪(LSL.W #8,D0⓪(MOVE.L D0,A0⓪(LSL.W #2,D0⓪(ADD.W A0,D0⓪(ADD CursorX,D0 ; ist immer gerade X-Pos.⓪(MOVE.L pScreen,A0⓪(ADDA.W D0,A0⓪ *)⓪(LSL.W #4,D0⓪(MULU rowBytes,D0⓪(MOVE CursorX,D1⓪(EXT.L D1⓪(ADD.L D1,D0⓪(MOVE.L pScreen,A0⓪(ADDA.L D0,A0⓪(MOVE.W rowBytes,D2⓪(EXT.L D2⓪(⓪(MOVE.L A0,-(A7)⓪(MOVE #15,-(A7) ; Loop-Counter⓪ l1 MOVE 6(A7),D0⓪(CLR D1⓪ l2 MOVE D1,(A0)+ ; Eine Raster-Zeile löschen⓪(DBRA D0,l2⓪(ADD.L D2,2(A7)⓪(MOVE.L 2(A7),A0⓪(SUBQ #1,(A7) ; alle 16 Raster-Zeilen löschen⓪(BCC l1⓪(ADDQ.L #8,A7⓪(MOVE.L (A7)+,D2⓪(MOVE (A7)+,D1⓪ ClEolE1 RTS⓪ ⓪ disp8x8 MOVE cols,D0 ; 80⓪(SUB CursorX,D0 ; ergibt gerade Anzahl zu löschender Words⓪(BLS ClEolE1⓪(LSR #1,D0 ; Anzahl Longs⓪(SUBQ #1,D0⓪(MOVE D4,-(A7)⓪(MOVE D0,-(A7)⓪(; Screenoffset := CursorY * 160 * 8 + CursorX * 2⓪(MOVE.W CursorY,D0⓪(; D0 * 1280⓪(LSL.W #8,D0⓪(MOVE D0,D4⓪(LSL.W #2,D0⓪(ADD.W D4,D0⓪(MOVE CursorX,D4 ; ist immer gerade X-Pos.⓪(LSL #1,D4⓪(ADD D4,D0⓪(MOVE.L pScreen,A0⓪(ADDA.W D0,A0⓪(MOVE.L A0,-(A7)⓪(MOVE #7,-(A7) ; Loop-Counter⓪ l3 MOVE 6(A7),D0⓪(CLR D4⓪ l4 MOVE.L D4,(A0)+ ; Eine Raster-Zeile löschen⓪(DBRA D0,l4⓪(ADDI.L #160,2(A7)⓪(MOVE.L 2(A7),A0⓪(SUBQ #1,(A7) ; alle 8 Raster-Zeilen löschen⓪(BCC l3⓪(ADDQ.L #8,A7⓪(MOVE (A7)+,D4⓪ END;⓪ END ClearEndOfLine;⓪ ⓪ (*$l-*)⓪ PROCEDURE BufferWrite ( buf : ADDRESS; no : CARDINAL );⓪ BEGIN⓪ ASSEMBLER⓪(MOVEM.L D0/D6/A0/A1/A2,-(A7)⓪(JSR ScrnCurOff⓪(MOVE.W -(A3),D6⓪(MOVE.L -(A3),A2⓪(BRA.L cont0⓪ ⓪ JScrnCurOff⓪(JMP ScrnCurOff⓪ ⓪ InverseOff⓪(CLR Inverse⓪(RTS⓪ ⓪ InverseOn⓪(MOVE #1,Inverse⓪ ClEolE0 RTS⓪ ⓪ ClearLine⓪(MOVE CursorX,-(A7)⓪(CLR.W CursorX⓪(JSR ClearEndOfLine⓪(MOVE (A7)+,CursorX⓪(RTS⓪ ⓪ CursorHome⓪(CLR.W CursorX⓪(CLR.W CursorY⓪(RTS⓪ ⓪ ClearEoL⓪(JMP ClearEndOfLine⓪ ⓪ ClearScrn⓪(BSR CursorHome⓪ ⓪ ClearEoS⓪(JSR ClearEndOfLine⓪(MOVE CursorX,-(A7)⓪(MOVE CursorY,-(A7)⓪(CLR.W CursorX⓪ ClrEosL ADDQ.W #1,CursorY⓪(MOVE CursorY,D0⓪(CMP Lines,D0⓪(BCC ClrEosE⓪(JSR ClearEndOfLine⓪(BRA ClrEosL⓪ ClrEosE MOVE (A7)+,CursorY⓪(MOVE (A7)+,CursorX⓪ ScrnRTS RTS⓪ ⓪ scru2: MOVEM.L D1-D7/A2-A6,-(A7)⓪(MOVE.L pScreen,A0⓪(MOVE.L A0,A1⓪(MOVE.W rowBytes,D2⓪(MULU HeightOfTextLine,D2⓪(ADDA.L D2,A1⓪(MOVE.W NoOfGraphicLines,D0⓪(SUB.W LinesPerChar,D0⓪(SUBQ.W #1,D0⓪(MOVE.W rowBytes,D2⓪(MOVE.W NoOfTextRows,D3⓪(SUB.W D3,D2⓪(LSR.W #2,D3⓪(SUBQ #1,D3⓪ l2: MOVE D3,D1⓪ l1: MOVE.L (A1)+,(A0)+⓪(DBRA D1,l1⓪(ADDA.W D2,A1⓪(ADDA.W D2,A0⓪(DBRA D0,l2⓪(MOVEM.L (A7)+,D1-D7/A2-A6⓪(RTS⓪ ⓪ ScrollUp⓪(bra scru2⓪ (*⓪(CMPI #80,rowBytes⓪(BNE scru2⓪(MOVEM.L D1-D7/A2-A6,-(A7)⓪(MOVE.L pScreen,A0⓪(MOVE.L A0,A1⓪(ADDA.W #1280,A1⓪(MOVE.W #640-1,D0⓪ ScrlUL1 MOVEM.L (A1)+,D1-D7/A2-A6⓪(MOVEM.L D1-D7/A2-A6,(A0)⓪(ADDA.W #48,A0 ; = 12 * 4⓪(DBRA D0,ScrlUL1⓪(MOVEM.L (A7)+,D1-D7/A2-A6⓪(RTS⓪ *)⓪ ⓪ scrd2: MOVEM.L D1-D7/A2-A6,-(A7)⓪(MOVE.L pScreen,A0⓪(MOVE.L A0,A1⓪(MOVE.W NoOfGraphicLines,D0⓪(SUB.W LinesPerChar,D0⓪(SUBQ.W #1,D0⓪(MOVE.W rowBytes,D2⓪(MULU D0,D2⓪(ADDA.L D2,A0⓪(ADDA.L D2,A1⓪(MOVE.W rowBytes,D2⓪(MULU HeightOfTextLine,D2⓪(ADDA.L D2,A0⓪(MOVE.W rowBytes,D2⓪(MOVE.W NoOfTextRows,D3⓪(ADD.W D3,D2⓪(LSR.W #2,D3⓪(SUBQ #1,D3⓪ m2: MOVE D3,D1⓪ m1: MOVE.L (A1)+,(A0)+⓪(DBRA D1,m1⓪(SUBA.W D2,A1⓪(SUBA.W D2,A0⓪(DBRA D0,m2⓪(MOVEM.L (A7)+,D1-D7/A2-A6⓪(RTS⓪ ⓪ ScrollDown⓪(bra scrd2⓪ (*⓪(CMPI #80,rowBytes⓪(BNE scrd2⓪(MOVEM.L D1-D7/A2-A6,-(A7)⓪(MOVE.L pScreen,A0⓪(ADDA.W #32000,A0⓪(MOVE.L A0,A1⓪(SUBA.W #1280,A1⓪(MOVE.W #640-1,D0⓪ ScrlDL1 SUBA.W #48,A1 ; = 12 * 4⓪(MOVEM.L (A1),D1-D7/A2-A6⓪(MOVEM.L D1-D7/A2-A6,-(A0)⓪(DBRA D0,ScrlDL1⓪(MOVEM.L (A7)+,D1-D7/A2-A6⓪(RTS⓪ *)⓪ ⓪ ScrnCR CLR.W CursorX⓪(⓪ CursorDown⓪(ADDQ.W #1,CursorY⓪(MOVE CursorY,D0⓪(CMP Lines,D0⓪(BCS CurDE⓪(MOVE.W Lines,D0⓪(SUBQ #1,D0⓪(MOVE D0,CursorY⓪(BSR ScrollUp⓪ CurDC MOVE CursorX,-(A7)⓪(CLR.W CursorX⓪(JSR ClearEndOfLine⓪(MOVE (A7)+,CursorX⓪ CurDE RTS⓪(⓪ CursorUp⓪(SUBQ #1,CursorY⓪(BCC CurDE⓪(CLR CursorY⓪(BSR ScrollDown⓪(BRA CurDC⓪ (*⓪ IncCursor⓪(ADDQ.W #1,CursorX⓪ ChkCursor⓪(MOVE CursorX,D0⓪(CMP cols,D0⓪(BCS CurDE⓪(CLR.W CursorX⓪(BRA CursorDown⓪ *)⓪ DecCursor⓪(SUBQ.W #1,CursorX⓪(BCC ScrnRTS⓪(MOVE cols,CursorX⓪(SUBQ.W #1,CursorX⓪(BRA CursorUp⓪ ⓪ BackSpace⓪(BSR DecCursor⓪(MOVEQ #' ',D0⓪(JMP DispChar⓪(⓪ ScrnCurOn⓪(; CLR.L CursorCnt⓪(; BSR ChkCursor⓪(TST CursorState⓪(BNE CurOnE⓪(JSR InvertChar⓪(MOVE #1,CursorState⓪ CurOnE RTS⓪ ⓪ CtrlOut CMPI #CRChar,D0⓪(BEQ ScrnCR⓪(CMPI #BSChar,D0⓪(BEQ BackSpace⓪(CMPI #LeftChar,D0⓪(BEQ DecCursor⓪(CMPI #UpChar,D0⓪(BEQ CursorUp⓪(CMPI #DownChar,D0⓪(BEQ CursorDown⓪(CMPI #HomeChar,D0⓪(BEQ CursorHome⓪(CMPI #ClrLnChar,D0⓪(BEQ ClearLine⓪(CMPI #ClrScrnChar,D0⓪(BEQ ClearScrn⓪(CMPI #ClrEolnChar,D0⓪(BEQ ClearEoL⓪(CMPI #ClrEoSChar,D0⓪(BEQ ClearEoS⓪(CMPI #Cursoronchar,D0⓪(BEQ ScrnCurOn⓪(CMPI #Cursoroffchar,D0⓪(BEQ JScrnCurOff⓪(CMPI #Inverseoffchar,D0⓪(BEQ InverseOff⓪(CMPI #Inverseonchar,D0⓪(BEQ InverseOn⓪(RTS⓪(⓪ OutC0 TST D0⓪(BEQ end0⓪(BSR CtrlOut⓪(BRA cont0⓪ ⓪ OutC1 JSR InvertChar⓪(BRA OutC2⓪ ⓪ ScrnOut CLR D0⓪(MOVE.B (A2)+,D0⓪(CMPI #' ',D0⓪(BCS OutC0⓪(JSR DispChar⓪(TST Inverse⓪(BNE OutC1⓪ OutC2 ADDQ.W #1,CursorX⓪ cont0 DBRA D6,ScrnOut⓪ end0 MOVEM.L (A7)+,D0/D6/A0/A1/A2⓪ END⓪ END BufferWrite;⓪ ⓪ (* ED3.ICL *)⓪ ⓪ (*$L-*)⓪ PROCEDURE Rename (oldName, newName: ADDRESS): INTEGER;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),-(A7) ; newName⓪(MOVE.L -(A3),-(A7) ; oldName⓪(CLR -(A7)⓪(MOVE #$56,-(A7)⓪(TRAP #1⓪(ADDA.W #12,A7⓪(TST.L D0⓪(BMI E⓪(MOVEQ #0,D0⓪%E: MOVE D0,(A3)+⓪$END⓪"END Rename;⓪ ⓪ (*$L-*)⓪ PROCEDURE FDelete (name: ADDRESS): INTEGER;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),-(A7)⓪(MOVE #$41,-(A7)⓪(TRAP #1⓪(ADDQ.L #6,A7⓪(TST.L D0⓪(BMI E⓪(MOVEQ #0,D0⓪%E: MOVE D0,(A3)+⓪$END⓪"END FDelete;⓪ ⓪ (*$l+*)⓪ PROCEDURE GotoXY ( x, y : cardinal );⓪ BEGIN⓪"CursorX := x;⓪"CursorY := y⓪ END GotoXY;⓪ ⓪ PROCEDURE Conout ( c: CHAR );⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #1,A3⓪(MOVE.B -(A3),D0⓪(MOVE D0,-(A7)⓪(MOVE #2,-(A7)⓪(MOVE #3,-(A7)⓪(TRAP #13⓪(ADDQ.L #6,A7⓪$END⓪"END Conout;⓪"(*$L=*)⓪ ⓪ (*$l+*)⓪ PROCEDURE Bell;⓪ BEGIN⓪"Conout (7C)⓪ END Bell;⓪ ⓪ ⓪ PROCEDURE Today (): CARDINAL;⓪"BEGIN⓪$RETURN PackDate (CurrentDate ())⓪"END Today;⓪ ⓪ PROCEDURE DirTime (): CARDINAL;⓪"BEGIN⓪$RETURN PackTime (CurrentTime ())⓪"END DirTime;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE GotoXYd1; (* GoToXY Highbyte(d1)=Y, Lowbyte(d1)=X *)⓪ BEGIN⓪ ASSEMBLER ;rettet nur d1,a0⓪(movem.l d1/a0,-(a7)⓪(cmp.b maxCol,d1⓪(bls nopa⓪(move.b maxCol,d1⓪ nopa move d1,ptrY⓪(move.b d1,ptrX⓪(clr (a3)+⓪(move.b d1,-1(a3)⓪(lsr #8,d1⓪(move d1,(a3)+⓪(jsr GoToXY⓪(movem.l (a7)+,d1/a0⓪ END⓪ END GotoXYd1;⓪ ⓪ (*$l-*)⓪ PROCEDURE ChrOut; (* Ausgabe eines Zeichens in d0 *)⓪ BEGIN (* mit Aktualisierung der X,Y-Koordinaten *)⓪ ASSEMBLER ;rettet alle Register⓪(movem.l d0/d1/d2/d3/d4/d5/d6/a0/A1/A2,-(a7)⓪(cmpi.b #' ',d0⓪(bcc asciich⓪(cmpi.b #CRchar,d0⓪(bne ctrl1⓪ newlin addq.b #1,ptrY⓪(clr.b ptrX⓪(moveq #0,d1⓪(move.b ptrY,d1⓪(cmp.w maxLine,d1⓪(bls doit⓪(bra lineup⓪ ctrl1 cmpi.b #LeftChar,d0⓪(beq ctrl11⓪(cmpi.b #BSchar,d0⓪(bne ctrl2⓪ ctrl11 subq.b #1,ptrX⓪(bpl doit⓪(move.b maxCol,ptrX⓪ lineup subq.b #1,ptrY⓪(bpl doit⓪(clr.b ptrY⓪(bra doit⓪ ctrl2 cmpi.b #ClrScrnChar,d0⓪(bne doit⓪(clr.b ptrY⓪(clr.b ptrX⓪(bra doit⓪ asciich move.b ptrX,d1⓪(cmp.b maxCol,d1⓪(bcc newlin⓪(addq.b #1,d1⓪(move.b d1,ptrX⓪ doit lea printLine,a0⓪(move.b d0,(a0)⓪(move.l a0,(a3)+⓪(move #1,(a3)+⓪(jsr BufferWrite⓪(movem.l (a7)+,d0/d1/d2/d3/d4/d5/d6/a0/A1/A2⓪ END⓪ END ChrOut;⓪ ⓪ (*$l-*)⓪ PROCEDURE Write(cr: CHAR); (* dieses Write geht ⁿber ChrOut *)⓪ BEGIN⓪ ASSEMBLER⓪(subq.l #1,a3⓪(move.b -(a3),d0⓪(jmp ChrOut⓪ END⓪ END Write;⓪ ⓪ (*$l-*)⓪ PROCEDURE WriteLn; (* damit x-y-Koord. bekannt *)⓪ BEGIN⓪"ASSEMBLER moveq #CRchar,d0 jmp ChrOut END⓪ END WriteLn;⓪ ⓪ (*$l-*)⓪ PROCEDURE ClrLn; (* damit x-y-Koord. bekannt *)⓪ BEGIN⓪ ASSEMBLER⓪(moveq #ClrEOLNchar,d0⓪(jsr ChrOut⓪(jmp WriteLn⓪ END⓪ END ClrLn;⓪ ⓪ (*$l-*)⓪ PROCEDURE WriteString(REF s:ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(ADDQ #1,-2(A3)⓪(jsr BufferWrite⓪(move cursorX,d1⓪(move.b d1,ptrX⓪(move cursorY,d1⓪(move.b d1,ptrY⓪ END;⓪ END WriteString;⓪ ⓪ ⓪ (*$l+*)⓪ PROCEDURE WriteLCard(c:LONGCARD);⓪ BEGIN⓪"WriteString (CardToStr(c,0))⓪ END WriteLCard;⓪ ⓪ ⓪ (*$l+*)⓪ PROCEDURE PrintError ( errno : INTEGER );⓪ VAR s: String;⓪ BEGIN⓪"writestring('I/O error: ');⓪"GetStateMsg (errno, s);⓪"writestring(s);⓪"writeln;⓪ END PrintError;⓪ ⓪ VAR LastKey: GemChar;⓪$LastMeta: SpecialKeySet;⓪$buttons: mButtonSet;⓪$Mousepoint: Point;⓪$keyBuffered: BOOLEAN;⓪ ⓪ (*$L+*)⓪ PROCEDURE LookForKey;⓪"VAR events: EventSet; clicks: CARDINAL; key: GemChar; keystate: SpecialKeySet;⓪&mp: Point; msgbuf: MessageBuffer; buts: MButtonSet;⓪"BEGIN⓪$MultiEvent (EventSet {keyboard, timer},⓪00, MButtonSet {}, MButtonSet {},⓪0lookForEntry, Rectangle{0,0,0,0},⓪0lookForEntry, Rectangle{0,0,0,0},⓪0msgbuf, 0, mp, buts, keystate, key, clicks, events);⓪$IF ~keyBuffered & (keyboard IN events) THEN⓪&keyBuffered:= TRUE;⓪&LastKey:= key;⓪&LastMeta:= keystate⓪$END⓪"END LookForKey;⓪ ⓪ (*$L-*)⓪ PROCEDURE KeyPressed () : BOOLEAN;⓪ BEGIN⓪ ASSEMBLER⓪(JSR LookForKey⓪(TST.L ShortKeyPtr⓪(BNE yes⓪((*⓪*MOVE #2,-(A7)⓪*MOVE #1,-(A7)⓪*TRAP #13⓪*ADDQ.L #4,A7⓪*TST.W D0⓪(*)⓪(MOVE keyBuffered,D0⓪ yes SNE D0⓪(AND #1,D0⓪(MOVE D0,(A3)+⓪ END⓪ END KeyPressed;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE GetKeyD0;⓪ BEGIN⓪ ASSEMBLER⓪(MOVEM.L D1/D2/A5/A6,-(A7)⓪ notValid⓪(TST.L ShortKeyPtr⓪(BNE GetShort⓪(⓪(moveq #CursorOnChar,d0⓪(jsr ChrOut⓪(⓪((*⓪*MOVE #2,-(A7)⓪*MOVE #2,-(A7)⓪*TRAP #13 ; Get Key⓪*ADDQ.L #4,A7⓪*MOVE.L D0,-(A7)⓪*MOVE.B (A7),D2 ; D2: shift status⓪*ANDI #$F,D2 ; nur shift, ctrl, alt drin lassen⓪*CLR.B (A7)⓪(*)⓪&waitforkey:⓪(JSR LookForKey⓪(TST keyBuffered⓪(BEQ waitforkey⓪(CLR keyBuffered⓪(move.w LastKey,D0⓪(andi #$FF,D0 ; Char-Code⓪(swap D0⓪(move.b LastKey,D0 ; Scan-Code⓪(andi #$FF,D0⓪(swap D0⓪(MOVE.L D0,-(A7)⓪(MOVE.B LastMeta,D2 ; D2: shift status⓪(ANDI #$F,D2 ; nur shift, ctrl, alt drin lassen⓪(⓪(moveq #CursorOffChar,d0⓪(jsr ChrOut⓪(⓪(MOVE.L (A7)+,D0⓪(⓪(TST inserting⓪(BEQ cont⓪(⓪(LEA shortKeys(PC),A5⓪ srch2 MOVE.L (A5)+,D1⓪(BEQ cont⓪(CMP.L D0,D1⓪(BNE noctrl⓪(MOVE.L A5,ShortKeyPtr⓪(BRA GetShort⓪ noctrl TST.B (A5)+⓪(BNE noctrl⓪(MOVE A5,D1⓪(BTST #0,D1⓪(BEQ srch2⓪(ADDQ.L #1,A5⓪(BRA srch2⓪ ⓪ GetShort⓪(MOVE.L ShortKeyPtr,A5⓪(CLR D0⓪(MOVE.B (A5)+,D0⓪(ADDQ.L #1,ShortKeyPtr⓪(TST.B (A5)⓪(BNE ende⓪(CLR.L ShortKeyPtr⓪(BRA ende⓪ ⓪ cont LEA ctrlkeys(PC),A5⓪(LEA keytabend(PC),A6⓪ srch CMP.L 2(A5),D0⓪(BNE noctrl2⓪ ⓪(MOVE (A5),D0⓪(CMPI #UpKey,D0⓪(BEQ up2⓪(CMPI #DownKey,D0⓪(BEQ down2⓪(CMPI #TabRightKey,D0⓪(BNE ende⓪(TST.B D2⓪(BEQ ende⓪(MOVEQ #TabLeftKey,D0⓪(BRA ende⓪ up2 BTST #2,D2 ; ctrl gedrückt?⓪(BEQ ende⓪(MOVEQ #ScrlDownKey,D0⓪(BRA ende⓪ down2 BTST #2,D2 ; ctrl gedrückt?⓪(BEQ ende⓪(MOVEQ #ScrlUpKey,D0⓪(BRA ende⓪ ⓪ noctrl2 ADDQ.L #6,A5⓪(CMPA.L A6,A5⓪(BCS srch⓪ ⓪(CMPI.L #' ',D0⓪(BCS notValid ; Controlzeichen nicht direkt zugelassen⓪ ⓪ ende MOVEM.L (A7)+,D1/D2/A5/A6⓪(RTS⓪(⓪ ctrlkeys⓪(DC.W HelpKey DC.L $620000L⓪(DC.W ESCKey DC.L $610000L ; Undo⓪(DC.W ETXkey DC.L $3B0000L ; F1⓪(DC.W SoLnKey DC.L $4B0034L ; SHIFT cursor left⓪(DC.W EoLnKey DC.L $4D0036L ; SHIFT cursor right⓪(DC.W WordLeftKey DC.L $730000L ; CTRL cursor left⓪(DC.W WordRightKey DC.L $740000L ; CTRL cursor right⓪(DC.W SoLnKey DC.L $430000L ; F9⓪(DC.W EoLnKey DC.L $440000L ; F10⓪(DC.W ScrlUpKey DC.L $410000L ; F7⓪(DC.W ScrlDownKey DC.L $420000L ; F8⓪(DC.W ESCKey DC.L $01001BL⓪(DC.W ToggleTabKey DC.L $3C0000L ; F2⓪(DC.W ETXKey DC.L $72000DL ; ENTER⓪(DC.W EnterKey DC.L $1C000DL ; RETURN⓪(DC.W DELKey DC.L $53007FL⓪(DC.W BSKey DC.L $0E0008L⓪(DC.W INSKey DC.L $520000L⓪(DC.W LeftKey DC.L $4B0000L⓪(DC.W RightKey DC.L $4D0000L⓪(DC.W UpKey DC.L $480000L⓪(DC.W DownKey DC.L $500000L⓪(DC.W PageUpKey DC.L $480038L ; SHIFT cursor up⓪(DC.W PageDownKey DC.L $500032L ; SHIFT cursor down⓪(DC.W TabLeftKey DC.L $100011L ; CTRL-Q⓪(DC.W TabRightKey DC.L $0F0009L ; TAB⓪(DC.W OpenFrameKey DC.L $3D0000L ; F3⓪(DC.W CloseFrameKey DC.L $3E0000L ; F4⓪(DC.W CompileKey DC.L $3F0000L ; F5⓪(DC.W HomeKey DC.L $470000L ; Clr/Home⓪(DC.W FindDefKey DC.L $400000L ; F6⓪ ⓪ keytabend⓪ ⓪ shortKeys⓪(DC.L $300000L ASC 'BEGIN' DC.B EnterKey ASC ' '⓪8DC.B EnterKey,LeftKey,LeftKey ASC 'END ;'⓪8DC.B EnterKey,ETXKey,LeftKey,LeftKey ACZ 'I' SYNC⓪(DC.L $170000L ACZ 'INTEGER' SYNC⓪(DC.L $190000L ACZ 'PROCEDURE ' SYNC⓪(DC.L $180000L ACZ 'BOOLEAN' SYNC⓪(DC.L $110000L ACZ 'WHILE ' SYNC⓪(DC.L $120000L DC.B LeftKey,LeftKey ASC 'END;' DC.B EnterKey,0 SYNC⓪(DC.L $130000L ASC 'REPEAT' DC.B EnterKey ACZ ' ' SYNC⓪8DC.B EnterKey,LeftKey,LeftKey ASC 'UNTIL ;'⓪8DC.B ETXKey, UpKey ACZ 'I' SYNC⓪(DC.L $2E0000L ACZ 'CARDINAL' SYNC⓪(DC.L $2F0000L ACZ 'WriteString (' SYNC⓪(DC.L $310000L ASC 'WriteLn;' DC.B EnterKey, 0 SYNC⓪(DC.L $1E0000L ASC 'ASSEMBLER' DC.B EnterKey,TabRightKey,0 SYNC⓪(DC.L $1F0000L ACZ 'String' SYNC⓪(DC.L $200000L ASC 'DO' DC.B EnterKey ASC ' '⓪8DC.B EnterKey,LeftKey,LeftKey ASC 'END;'⓪8DC.B ETXKey, UpKey ACZ 'I' SYNC⓪(DC.L $210000L ACZ 'FOR ' SYNC⓪(DC.L $260000L ACZ 'LONGCARD' SYNC⓪(DC.L $250000L ACZ 'LONGINT' SYNC⓪(DC.L $2C0000L ACZ 'ADDRESS' SYNC⓪(DC.L $160000L ACZ 'UNTIL ' SYNC⓪(DC.L $140000L ASC 'THEN' DC.B EnterKey ASC ' '⓪8DC.B EnterKey,LeftKey,LeftKey ASC 'END;'⓪8DC.B ETXKey, UpKey ACZ 'I' SYNC⓪(DC.L $150000L ACZ 'FROM SYSTEM IMPORT ' SYNC⓪(DC.L $220000L ASC 'FROM InOut IMPORT Write, WriteLn, WriteString, WriteInt, WriteCard;'⓪8DC.B EnterKey, 0 SYNC⓪(DC.L 0⓪ END⓪ END GetKeyD0;⓪ ⓪ PROCEDURE ClrKBDbuffer;⓪"BEGIN⓪$WHILE KeyPressed () DO GetKeyD0; ShortKeyPtr := NIL END⓪"END ClrKBDbuffer;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE ChrIn; (* d0=Zeichen von Tastatur *)⓪ BEGIN (* ohne Echo *)⓪ ASSEMBLER⓪(clr accept⓪(clr abort⓪ liest jsr GetKeyD0⓪(cmpi #ToggleTabKey,d0⓪(bne ct10⓪(moveq #0,d3⓪(move.b ptrX,d3⓪(move d3,d1⓪(lsr #3,d1⓪(lea tabs,A0⓪(bchg d3,0(a0,d1.w)⓪(bne decr⓪(addq #1,nrOfTabs⓪(bra tabcmd⓪ decr subq #1,nrOfTabs⓪ tabcmd tst tabMode⓪(beq ctende ;liest⓪(clr cmdFlag⓪(;bra liest⓪(bra ctende⓪ ct10 cmpi #ESCkey,d0⓪(bne ct11⓪(move #1,abort⓪(bra ctende⓪ ct11 cmpi #ETXkey,d0⓪(bne ctende⓪(move #1,accept⓪(;bra ctende⓪ ctende⓪ END⓪ END ChrIn;⓪ ⓪ (*$l-*)⓪ PROCEDURE ReadCh; (* ch:=Zeichen vom KBD *)⓪ BEGIN⓪ ASSEMBLER⓪(jsr ChrIn⓪(move.b d0,ch⓪ END⓪ END ReadCh;⓪ ⓪ (*$l-*)⓪ PROCEDURE ErrorWait;⓪ BEGIN⓪"ClrKBDbuffer;⓪"GetKeyD0⓪ END ErrorWait;⓪ ⓪ (*$l-*)⓪ PROCEDURE SuccessFull(id: CARDINAL):BOOLEAN;⓪ BEGIN⓪ ASSEMBLER⓪(tst IOResult⓪(bpl NoErr⓪(movem.l d0-d6/a0/A1/A2,-(a7)⓪(move IOResult,-(a7)⓪(moveq #CRchar,d0⓪(jsr ChrOut⓪(moveq #ClrEOLNchar,d0⓪(jsr ChrOut⓪(moveq #0,d0⓪(move -(a3),d0⓪ (*⓪(move.l d0,(a3)+⓪(lea ErrorType,a0⓪(move.b 0(a0,d0.w),d0⓪(jsr ChrOut⓪(jsr WriteLCard⓪(moveq #':',d0⓪(jsr ChrOut⓪ *)⓪(move (a7),(a3)+⓪(jsr PrintError⓪(jsr Bell⓪(jsr ErrorWait⓪(move (a7)+,IOResult⓪(movem.l (a7)+,d0-d6/a0/A1/A2⓪(clr (a3)+⓪(rts⓪ NoErr move #1,-2(a3)⓪ END⓪ END SuccessFull;⓪ ⓪ (*$l-*)⓪ PROCEDURE Flip(VAR s1,s2:STRING);⓪ BEGIN (* vertauscht s1 mit s2 *)⓪ ASSEMBLER⓪(move.l -(a3),a0⓪(move.l -(a3),A1⓪(moveq #40,d1⓪ Flipx move (a0),d0⓪(move (A1),(a0)+⓪(move d0,(A1)+⓪(dbf d1,Flipx⓪ END⓪ END Flip;⓪ ⓪ (*$l+*)⓪ PROCEDURE ReadString(VAR str: string); (* mit Umcodierung *)⓪"VAR line:STRING; (* bei ESC bleibt str erhalten *)⓪ BEGIN⓪ ASSEMBLER⓪*moveq #0,d1⓪ readstrw jsr ChrIn⓪*tst abort⓪*bne readabrt⓪*cmpi.b #' ',d0⓪*bcs readctrl⓪ readnorm move.b ptrX,d2⓪*cmp.b maxColM1,d2⓪*bhi readerr⓪*move.b d0,line(A6,d1.w)⓪*addq #1,d1⓪*jsr ChrOut⓪*bra readstrw⓪ readctrl cmpi #EnterKey,d0⓪*beq readcr⓪*cmpi #leftKey,d0⓪*beq readleft⓪*cmpi #bsKey,d0⓪*beq readleft⓪*cmpi #delKey,d0⓪*beq readleft⓪ readerr bra readstrw⓪ readleft tst d1⓪*ble readerr⓪*subq #1,d1⓪*moveq #BSChar,d0⓪*jsr ChrOut⓪*bra readstrw⓪ readcr clr.b line(A6,d1.w) END; Flip(str,line); ASSEMBLER⓪ !readabrt jsr WriteLn⓪ END⓪ END ReadString;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE Worthy: BOOLEAN;⓪ BEGIN⓪ ASSEMBLER⓪(moveq #1,d1⓪(move.l ptrEnd,d0⓪(sub.l ptrStart,d0⓪(cmpi.l #4,d0⓪(bhi itisw⓪(moveq #0,d1⓪ itisw move d1,(a3)+⓪ END⓪ END Worthy;⓪ ⓪ PROCEDURE NormTab;⓪"BEGIN⓪$ASSEMBLER⓪(DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F⓪(DC.B $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2A,$2B,$2C,$2D,$2E,$2F⓪(DC.B $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3A,$3B,$3C,$3D,$3E,$3F⓪(DC.B $40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,$4D,$4E,$4F⓪(DC.B $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A,$5B,$5C,$5D,$5E,$5F⓪(DC.B $60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6A,$6B,$6C,$6D,$6E,$6F⓪(DC.B $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7A,$7B,$7C,$7D,$7E,$7F⓪(DC.B $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8A,$8B,$8C,$8D,$8E,$8F⓪(DC.B $90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9A,$9B,$9C,$9D,$9E,$9F⓪(DC.B $A0,$A1,$A2,$A3,$A4,$A5,$A6,$A7,$A8,$A9,$AA,$AB,$AC,$AD,$AE,$AF⓪(DC.B $B0,$B1,$B2,$B3,$B4,$B5,$B6,$B7,$B8,$B9,$BA,$BB,$BC,$BD,$BE,$BF⓪(DC.B $C0,$C1,$C2,$C3,$C4,$C5,$C6,$C7,$C8,$C9,$CA,$CB,$CC,$CD,$CE,$CF⓪(DC.B $D0,$D1,$D2,$D3,$D4,$D5,$D6,$D7,$D8,$D9,$DA,$DB,$DC,$DD,$DE,$DF⓪(DC.B $E0,$E1,$E2,$E3,$E4,$E5,$E6,$E7,$E8,$E9,$EA,$EB,$EC,$ED,$EE,$EF⓪(DC.B $F0,$F1,$F2,$F3,$F4,$F5,$F6,$F7,$F8,$F9,$FA,$FB,$FC,$FD,$FE,$FF⓪$END⓪"END NormTab;⓪ ⓪ PROCEDURE AlphaNumTab;⓪"BEGIN⓪$ASSEMBLER⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0⓪(DC.B 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0⓪(DC.B 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1⓪(DC.B 0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1⓪(DC.B 0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪$END⓪"END AlphaNumTab;⓪ ⓪ PROCEDURE ShiftTab;⓪"BEGIN⓪$ASSEMBLER⓪(DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F⓪(DC.B ' ','!','"','#','$','%','&',$27,'(',')','*','+',',','-','.','/'⓪(DC.B '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?'⓪(DC.B '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','[','\',']','^','_'⓪(DC.B '`','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','{','|','}','~',''⓪(DC.B 'Ç','Ü','É','A','Ä','À','Å','Ç','E','E','E','I','I','I','Ä','Å'⓪(DC.B 'É','Æ','Æ','O','Ö','O','U','U','ÿ','Ö','Ü','¢','£','¥','ß','ƒ'⓪(DC.B 'A','I','O','U','Ñ','Ñ','ª','º','¿','⌐','¬','½','¼','¡','«','»'⓪(DC.B 'Ã','Õ','Ø','Ø','Œ','Œ','À','Ã','Õ','¨','´','†','¶','©','®','™'⓪(DC.B 'Ĳ','Ĳ','א','ב','ג','ד','ה','ו','ז','ח','ט','י','כ','ל','מ','נ'⓪(DC.B 'ס','ע','פ','צ','ק','ר','ש','ת','ן','ך','ם','ף','ץ','§','∧','∞'⓪(DC.B 'α','β','Γ','π','Σ','σ','µ','τ','Φ','Θ','Ω','δ','∮','ϕ','∈','∩'⓪(DC.B '≡','±','≥','≤','⌠','⌡','÷','≈','°','∙','·','√','ⁿ','²','³','¯'⓪(;und gleich darauf noch die Lower-Table⓪(DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F⓪(DC.B ' ','!','"','#','$','%','&',$27,'(',')','*','+',',','-','.','/'⓪(DC.B '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?'⓪(DC.B '@','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o'⓪(DC.B 'p','q','r','s','t','u','v','w','x','y','z','[','\',']','^','_'⓪(DC.B '`','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o'⓪(DC.B 'p','q','r','s','t','u','v','w','x','y','z','{','|','}','~',''⓪(DC.B 'ç','ü','é','â','ä','à','å','ç','ê','ë','è','ï','î','ì','ä','å'⓪(DC.B 'é','æ','æ','ô','ö','ò','û','ù','ÿ','Ö','ü','¢','£','¥','ß','ƒ'⓪(DC.B 'á','í','ó','ú','ñ','ñ','ª','º','¿','⌐','¬','½','¼','¡','«','»'⓪(DC.B 'ã','õ','ø','ø','œ','œ','à','ã','õ','¨','´','†','¶','©','®','™'⓪(DC.B 'ĳ','ĳ','א','ב','ג','ד','ה','ו','ז','ח','ט','י','כ','ל','מ','נ'⓪(DC.B 'ס','ע','פ','צ','ק','ר','ש','ת','ן','ך','ם','ף','ץ','§','∧','∞'⓪(DC.B 'α','β','Γ','π','Σ','σ','µ','τ','Φ','Θ','Ω','δ','∮','ϕ','∈','∩'⓪(DC.B '≡','±','≥','≤','⌠','⌡','÷','≈','°','∙','·','√','ⁿ','²','³','¯'⓪$END⓪"END ShiftTab;⓪ ⓪ (*$l-*)⓪ PROCEDURE ShiftUp; (* kleine Buchstaben => große *)⓪ BEGIN⓪ ASSEMBLER ;operiert auf d0⓪(cmpi.b #'a',d0⓪(bcs shftrts⓪(cmpi.b #'z',d0⓪(bls shiftit⓪(cmpi.b #132,d0⓪(beq ae⓪(cmpi.b #148,d0⓪(beq oe⓪(cmpi.b #129,d0⓪(bne shftrts⓪(moveq #154,d0⓪(rts⓪ ae moveq #142,d0⓪(rts⓪ oe moveq #153,d0⓪(rts⓪ shiftit eori.b #$20,d0⓪ shftrts⓪ END⓪ END ShiftUp;⓪ ⓪ (*$l-*)⓪ PROCEDURE AlphaNum; (* Test, ob d0 ein alphanum. Zeichen enth. *)⓪ BEGIN (* Ergebnis im Z-Flag:1=alphanum *)⓪ ASSEMBLER⓪)ANDI #255,D0⓪)MOVE.L A0,-(A7)⓪)LEA AlphaNumTab,A0⓪)TST.B 0(A0,D0.W)⓪)MOVE.L (A7)+,A0⓪ END⓪ END AlphaNum;⓪ ⓪ (*$l-*)⓪ PROCEDURE ClearTabs;⓪"BEGIN⓪$ASSEMBLER⓪(lea tabs,a0⓪(moveq #0,d0⓪(move.b maxCol,d0⓪(addq #1,d0⓪(asr #3,d0⓪(subq #1,d0⓪ cllp clr.b (a0)+ ;tabs löschen⓪(dbf d0,cllp⓪$END⓪"END ClearTabs;⓪ ⓪ (*$l+*)⓪ PROCEDURE StandardTabs (n: CARDINAL);⓪"TYPE ByteSet = SET OF [0..7];⓪"VAR p: POINTER TO ARRAY [0..80] OF ByteSet; i: CARDINAL;⓪"BEGIN (* alle n Zeichen ein Tab *)⓪$ClearTabs;⓪$i:= 0;⓪$p:= ADR (tabs);⓪$nrOfTabs:= 0;⓪$WHILE i < cols DO⓪&INCL (p^[i DIV 8], i MOD 8);⓪&INC (nrOfTabs);⓪&INC (i, n)⓪$END;⓪"(*⓪'ASSEMBLER ;benutzt d0,a0⓪/moveq #0,d0⓪/move.b maxCol,d0⓪/addq #1,d0⓪/asr #3,d0⓪/move d0,nrOfTabs⓪/lea tabs,a0⓪/subq #1,d0⓪'tblp move.b #$01,(a0)+⓪/dbf d0,tblp⓪'END⓪"*)⓪"END StandardTabs;⓪ ⓪ (*$l-*)⓪ PROCEDURE CountTabs;⓪ BEGIN⓪ ASSEMBLER ;benutzt d0,a0⓪(moveq #0,d2⓪(move.b maxCol,d2⓪(move d2,d1⓪(addq #1,d2⓪(asr #3,d2⓪(lea tabs,a0⓪(subq #1,d2⓪ tblp move.b (a0)+,d0⓪(moveq #7,d3⓪ tbcnt btst #0,d0⓪(beq notset⓪(addq #1,d1⓪ notset lsr #1,d0⓪(dbf d3,tbcnt⓪(dbf d2,tblp⓪(move d1,nrOfTabs⓪ END⓪ END CountTabs;⓪ ⓪ (*$l+*)⓪ PROCEDURE GetTabs(tabString:String);⓪"VAR step, i, n: CARDINAL;⓪"BEGIN (* tabString umwandeln, 'T'=Tabulator, '.'=keiner *)⓪$i:= 0;⓪$n:= StrToCard (tabString, i, strok);⓪$IF (n > 0) AND (n<80) THEN⓪&StandardTabs (n)⓪$ELSE⓪&ASSEMBLER⓪(JSR ClearTabs⓪(lea tabString(A6),A0⓪(moveq #0,d0⓪(moveq #0,d1 ;d1=nrOfTabs⓪(lea tabs,A1⓪(moveq #0,d3 ;d3=Bit-Index⓪(tst.b (a0)⓪(bne gtloop⓪(move #8,(A3)+⓪(jsr StandardTabs⓪(bra getex⓪ gtloop move.b (a0)+,d0⓪(beq gete2⓪(jsr ShiftUp⓪(move d3,d4⓪(lsr #3,d4⓪(bclr d3,0(A1,d4.w)⓪(cmpi.b #'T',d0⓪(bne gtstor⓪(bset d3,0(A1,d4.w)⓪(addq #1,d1⓪ gtstor addq #1,d3⓪(bra gtloop⓪ gete2 move d1,nrOfTabs⓪ getex⓪&END⓪$END⓪"END GetTabs;⓪ ⓪ (*$l-*)⓪ PROCEDURE TabSet: BOOLEAN; (* true, wenn an aktueller *)⓪ BEGIN (* Cursorposition ein Tab steht *)⓪ ASSEMBLER ;benutzt d0,d1,d2,A2⓪(tst nrOfTabs⓪(beq tabf⓪(moveq #0,d1⓪(move.b ptrX,d1⓪(cmp.b maxColM1,d1⓪(bgt tabf⓪(move forceTab,d0⓪(lea tabs,A2⓪(move d1,d2⓪(lsr #3,d2⓪(btst d1,0(A2,d2.w)⓪(beq notab⓪ tabf moveq #1,d0⓪ notab move d0,(a3)+⓪ END⓪ END TabSet;⓪ ⓪ (*$l-*)⓪ PROCEDURE TabsToStr():String;⓪ BEGIN⓪ ASSEMBLER⓪(lea tabs,a0⓪(move.l a3,A1⓪(lea 82(A3),A3⓪(moveq #0,d0⓪(move.b maxCol,d0⓪(addq #1,d0⓪(asr #3,d0⓪(subq #1,d0⓪ lp1 moveq #7,d1⓪(move.b (a0)+,d2⓪ lp2 moveq #'.',d3⓪(lsr.b #1,d2⓪(bcc push⓪(moveq #'T',d3⓪ push move.b d3,(A1)+⓪(dbf d1,lp2⓪(dbf d0,lp1⓪(clr.b (A1)+⓪ END⓪ END TabsToStr;⓪ ⓪ (*$l-*)⓪ PROCEDURE Yes: BOOLEAN; (* true, falls y,Y,j,J eingegeben *)⓪ BEGIN⓪ ASSEMBLER⓪(jsr ErrorWait⓪(jsr ShiftUp⓪(moveq #1,d1⓪(cmpi #'J',d0⓪(beq jaret⓪(cmpi #'Y',d0⓪(beq jaret⓪(moveq #0,d1⓪ jaret move d1,(a3)+⓪ END⓪ END Yes;⓪ ⓪ (*$l-*)⓪ PROCEDURE DirKey: BOOLEAN; (* wertet Tasten zur Richtungs- *)⓪ BEGIN (* umschaltung aus *)⓪ ASSEMBLER ;benutzt d0,d1,d2⓪(moveq #0,d0⓪(move.b ch,d0⓪(move direction,d1⓪(moveq #0,d2⓪(cmpi.b #'<',d0⓪(beq dleft⓪(cmpi.b #',',d0⓪(beq dleft⓪(cmpi.b #'-',d0 ; '<' ',' '-' fⁿr links⓪(beq dleft⓪(cmpi.b #'>',d0⓪(beq dright⓪(cmpi.b #'.',d0⓪(beq dright⓪(cmpi.b #'+',d0 ; '>' '.' '+' fⁿr rechts⓪(bne dexit⓪ dright tst d1⓪(beq dexit⓪(clr d1⓪(bra dstore⓪ dleft tst d1⓪(bne dexit⓪(moveq #1,d1⓪ dstore move d1,direction⓪(clr cmdFlag⓪(moveq #1,d2⓪ dexit move d2,(a3)+⓪ END⓪ END DirKey;⓪ ⓪ (*$l-*)⓪ PROCEDURE ReadUpCh; (* liest einen Gro∞buchstaben vom KBD *)⓪ BEGIN⓪"ASSEMBLER jsr ChrIn jsr ShiftUp move.b d0,ch END⓪ END ReadUpCh;⓪ ⓪ (*$l-*)⓪ PROCEDURE Rptfx10:BOOLEAN; (* berechnet Repeatfactor (rptf) *)⓪ BEGIN (* d2 enthΣlt 1, wenn Zahl gefunden *)⓪ ASSEMBLER ;benutzt d0,d1,d2,d3⓪(moveq #0,d2⓪(moveq #0,d3⓪(move.b ch,d3⓪(subi.b #'0',d3 ;Low-Bound abziehen⓪(bcs rptfex⓪(cmpi.b #9,d3 ;>9?⓪(bhi rptfex⓪(move.l rptf,d0 ;alten Repeatfactor mal 10 nehmen⓪(move.l d0,d1⓪(asl.l #2,d1⓪(add.l d1,d0⓪(asl.l #1,d0⓪(add.l d3,d0 ;neue Ziffer addieren⓪(move.l d0,rptf⓪(moveq #1,d2 ;d2=1 => es wurde eine Zahl gefunden⓪ rptfex move d2,(a3)+⓪ END⓪ END Rptfx10;⓪ ⓪ (*$l-*)⓪ PROCEDURE RptfOK; (* gültiger Repeatfactor ? *)⓪ BEGIN⓪ ASSEMBLER ;benutzt d0⓪(move.l rptf,d0⓪(bne ok⓪(moveq #1,d0 ;Default=1⓪ ok move.l d0,rptf⓪ END⓪ END RptfOK;⓪ ⓪ (*$l-*)⓪ PROCEDURE Negate(VAR bool:BOOLEAN);⓪ BEGIN (* bool:=NOT bool *)⓪ ASSEMBLER move.l -(a3),a0 EORI #1,(a0) END⓪ END Negate;⓪ ⓪ (*$l-*)⓪ PROCEDURE Prepare;⓪ BEGIN⓪ ASSEMBLER⓪&(*⓪(pea printLine⓪(;### move.l (a7),(a3)+⓪(;### jsr GetTime⓪(move.l (a7)+,a0⓪(moveq #0,d0⓪(move (a0)+,d0⓪(mulu #60,d0⓪(add (a0)+,d0⓪(mulu #15,d0⓪(asl.l #2,d0⓪(moveq #0,d1⓪(move (a0)+,d1⓪(add.l d1,d0⓪&*) nop⓪ END⓪ END Prepare;⓪ ⓪ (*$l-*)⓪ PROCEDURE Finish;⓪ BEGIN⓪ ASSEMBLER⓪&(*⓪(jsr Prepare⓪(move.l d0,d1⓪(sub.l startupTime,d0⓪(bpl ok⓪(add.l #$15180,d0⓪ ok move.l d1,startupTime⓪(add.l d0,total⓪(add.l d0,keepTime⓪&*) nop⓪ END⓪ END Finish;⓪ ⓪ (*$l-*)⓪ PROCEDURE ResetTextOptions;⓪"BEGIN⓪$ASSEMBLER⓪(clr cmdFlag⓪(moveq #16-1+43-1,d0⓪(lea ptrStack,a0⓪%lp clr.l (a0)+ ;löscht auch tags⓪(dbf d0,lp⓪(move.l ptr,lastptr⓪(clr ptrCount⓪(clr fileD⓪(clr fileT⓪(clr restoreFileDT⓪(clr direction⓪(clr findSame⓪(clr findWord⓪(clr findCase⓪(clr infinite⓪(clr verify⓪(clr.l rptf⓪(move #1,saved⓪(clr autoBack⓪(clr autoIncVer⓪(move #1,makeDLE⓪(clr leaveDLEonWrite⓪(clr saveinfo⓪(move #8,(A3)+⓪(jsr StandardTabs⓪$END⓪"END ResetTextOptions;⓪ ⓪ (*$l-*)⓪ PROCEDURE GoToPtr; (* positioniert Cursor auf gespeicherte yx *)⓪ BEGIN⓪ ASSEMBLER⓪(move yx,d1⓪(jmp GotoXYd1⓪ END⓪ END GoToPtr;⓪ ⓪ (*$l-*)⓪ PROCEDURE Home; (* Cursor nach links oben, Statuszeile l÷schen *)⓪ BEGIN⓪ ASSEMBLER⓪(clr d1⓪(jsr GotoXYd1⓪(moveq #ClrEOLNchar,d0⓪(jmp ChrOut⓪ END⓪ END Home;⓪ ⓪ (*$l-*)⓪ PROCEDURE ClrCmdLine; (* Cursorposition retten, dann Home *)⓪ BEGIN⓪ ASSEMBLER⓪(clr cmdFlag⓪(move ptrY,d0⓪(move.b ptrX,d0⓪(move d0,yx⓪(jmp Home⓪ END⓪ END ClrCmdLine;⓪ ⓪ (*$l-*)⓪ PROCEDURE LineOut; (* eine Zeile aus Speicher auf Bildschirm bringen *)⓪ BEGIN (* dabei auf Cursorposition achten *)⓪"ASSEMBLER ;benutzt d0,d2,d3,d4,d5,d6,a0,A1,A2⓪,moveq #0,d3 ;ZΣhler fⁿr PrintLine / highword=x-pos⓪,lea printLine,A2⓪,moveq #0,d5⓪,tst insflag⓪,beq.l LineOut1⓪,move.b ptrX,d5⓪,bra.l LineOut1⓪"⓪"lget tst insFlag⓪,bne lgetnz ;bei Insert den Cursor nicht verΣndern⓪,cmpa.l ptr,a0⓪,bne lgetnz⓪,move ptrY,d0⓪,move.b d5,d0⓪,move d0,yx⓪"lgetnz moveq #0,d0⓪,move.b (a0)+,d0⓪,bne lendrts⓪,tst.b (a0)⓪,beq lendkorr⓪,subq.l #1,a0⓪,⓪"lendkorr move.b d3,ptrX⓪ ⓪,; move.b #ClrEOLNchar,0(A2,d3.w)⓪,; addq.b #1,d3⓪,movem.l d1/a0,-(a7)⓪,jsr BufferDisp ;Ausgabe von PrintLine⓪,jsr ClearEndOfLine⓪,movem.l (a7)+,d1/a0⓪,addq.l #4,a7 ;verlasse LineOut⓪"⓪"lendrts rts⓪"⓪"lput cmpi.b #CRchar,d0⓪,beq lendkorr⓪,tst delFlag⓪,beq lput1⓪,cmpa.l delPtr,a0⓪,bhi lput1⓪,cmpa.l ptr,a0⓪,bls lput1⓪,moveq #' ',d0⓪"lput1 cmp.b maxCol,d5⓪,bgt lputbad⓪,move.b d0,0(A2,d3.w)⓪,addq.b #1,d3⓪,cmpi.b #$20,d0⓪,bcs lputrts⓪"lputinc addq.b #1,d5⓪"lputrts rts⓪"lputbad move.b #'!',-1(A2,d3.w)⓪,rts⓪"⓪"ldlecode bsr lget⓪,move.b d0,d4⓪,moveq #' ',d0⓪,sub.b d0,d4⓪,ble LineOut1⓪"lspc bsr lput⓪,subq.b #1,d4⓪,bne lspc⓪,⓪"LineOut1 bsr lget⓪,cmpi.b #DLEchar,d0⓪,beq ldlecode⓪,bsr lput⓪,bra LineOut1⓪"END⓪ END LineOut;⓪ ⓪ (*$l-*)⓪ PROCEDURE LineSt; (* positioniert a0 auf Zeilenanfang im Speicher *)⓪ BEGIN⓪ ASSEMBLER ;benutzt d3,a0⓪ linecr1 move.b -(a0),d3⓪*beq lineret1⓪*cmpi.b #CRchar,d3⓪*bne linecr1⓪ lineret1 addq.l #1,a0⓪ END⓪ END LineSt;⓪ ⓪ (*$l-*)⓪ PROCEDURE LastCR; (* positioniert a0 auf vorhergehendes CR *)⓪((* liefert NE, wenn End of text *)⓪ BEGIN⓪ ASSEMBLER⓪ LastCR1 tst.b -1(a0)⓪*beq lastret1⓪*cmpi.b #CRchar,-(a0)⓪*bne LastCR1⓪*rts⓪ lastret1 cmpi.b #1,-1(a0) ; ergibt immer NE⓪ END⓪ END LastCR;⓪ ⓪ (*$l-*)⓪ PROCEDURE NextCR; (* positioniert a0 auf nächstes CR+1 *)⓪((* liefert NE, wenn End of text *)⓪ BEGIN⓪ ASSEMBLER⓪ luup cmpa.l ptrEnd,A0⓪+bcc error2⓪+tst.b (a0)⓪+beq error2⓪+cmpi.b #CRchar,(a0)+⓪+bne luup⓪+rts⓪ error2 move.l ptrEnd,a0⓪+subq.l #2,a0⓪ error cmpa.l a7,a0 ; liefert NE⓪ END⓪ END NextCR;⓪ ⓪ ⓪ VAR lineNo: LONGCARD;⓪ ⓪ (*$l-*)⓪ PROCEDURE CountCR: LONGCARD; (* zählt Zeilen=CR's *)⓪ BEGIN⓪ ASSEMBLER ;benutzt d0,d1,d2,a0⓪(clr.l lineNo⓪(move.l ptrStart,a0⓪(move.l ptr,A1⓪(moveq #1,d0⓪(moveq #CRchar,d2⓪ lbl cmpa.l a0,A1⓪(bne lbl2⓪(move.l d0,lineNo⓪ lbl2 move.b (a0)+,d3⓪(beq cntend⓪(cmp.b d2,d3⓪(bne lbl⓪(addq.l #1,d0⓪(bra lbl⓪ cntend move.l d0,(a3)+⓪ END⓪ END CountCR;⓪ ⓪ (*$l+*)⓪ PROCEDURE conc((*$? CompilerVersion > 3: REF*) a,b:Strings.String): Strings.String;⓪"VAR s: Strings.String;⓪"BEGIN⓪$Concat (a,b,s,strok);⓪$RETURN s⓪"END conc;⓪ ⓪ FORWARD PutCmd(REF k: ARRAY OF CHAR); (* String in Statuszeile drucken *)⓪ ⓪ (*$l-*)⓪ PROCEDURE Info; (* durch '?' ausgelöst *)⓪ BEGIN⓪"PutCmd(⓪"conc(conc(conc(conc('used:', CardToStr(ptrEnd-ptrStart-4L,6)),⓪1conc(' bytes; free:', CardToStr(bufferH-ptrEnd,7))),⓪,conc(conc(' bytes;', CardToStr(filesInMem,2)),⓪1conc(' frames;', CardToStr(CountCR(),5)))),⓪,conc(' lines; cursor:', CardToStr(lineNo,5))));⓪"ErrorWait⓪ END Info;⓪ ⓪ (*$l-*)⓪ PROCEDURE FindCursor; (* bringt Cursor in richtige x-Position *)⓪ BEGIN (* d1 mu∞ yx-Koordinaten enthalten *)⓪ ASSEMBLER (* a0 mu∞ auf Zeilenanfang zeigen *)⓪(moveq #0,d3⓪(move.b (a0),d4⓪(beq ma1z⓪(cmpi.b #DLEchar,d4⓪(bne fc1⓪(addq.l #1,a0⓪(move.b (a0)+,d3⓪(subi.b #DLEoffset,d3 ;d3=Space-Count⓪ fc1 cmp.b d3,d1⓪(bls ma0z⓪(move.b (a0),d4⓪(beq ma1z⓪(cmpi.b #CRchar,d4⓪(beq ma0z⓪(addq.l #1,a0⓪(cmpi.b #$20,d4⓪(bcs fc1⓪(addq.b #1,d3⓪(bra fc1⓪ ma1z subq.l #1,a0⓪(cmpi.b #dlechar,-1(a0)⓪(bne ma0z⓪(subq.l #1,a0⓪ ma0z move.l a0,ptr⓪(move.b d3,d1⓪(jmp GotoXYd1⓪ END⓪ END FindCursor;⓪ ⓪ (*$l-*)⓪ PROCEDURE ScreenOut; (* Bildschirm neu schreiben *)⓪ BEGIN (* am Textende letzte Zeile in die letzte *)⓪ ASSEMBLER (* Bildschirmzeile drucken *)⓪(move #1,screenOK⓪(move.l ptr,a0⓪(cmpi.b #DLEchar,(a0)⓪(bne nodle⓪(addq.l #1,a0⓪ nodle cmpi.b #DLEchar,-1(a0)⓪(bne nodleo⓪(addq.l #1,a0⓪ nodleo move.l a0,ptr⓪(move.l a0,scrPtr⓪(move ptrLine,d1⓪ pcr cmp maxLine,d1 ;bis in letzte Bildschirmzeile vorpirschen⓪(bge zcr⓪(jsr NextCR⓪(addq #1,d1⓪(bra pcr⓪ zcr subq #1,d1⓪(beq korr⓪(jsr LastCR ;wieder zurück, damit Bildschirm immer voll⓪(bra zcr⓪ korr jsr LineSt⓪(move #$174F,yx⓪(jsr GotoXYd1 ; D1 ist 0!⓪(move maxLine,d1⓪ scrn1 jsr WriteLn⓪(jsr LineOut⓪(subq #1,d1⓪(bne scrn1⓪(moveq #0,d0⓪(move.b yx,d0⓪(move d0,ptrLine⓪(jmp GoToPtr⓪ END⓪ END ScreenOut;⓪ ⓪ (*$l-*)⓪ PROCEDURE CenterScreen; (* Bildschirm schreiben, Cursor in Mitte *)⓪ BEGIN⓪ ASSEMBLER⓪(move maxLine,d0⓪(ASR #1,d0⓪(move d0,ptrLine⓪(jmp ScreenOut⓪ END⓪ END CenterScreen;⓪ ⓪ (*$l+*)⓪ PROCEDURE jumpPtr (p: ADDRESS);⓪"BEGIN⓪$IF (ptrStart<p) & (p<ptrEnd) THEN⓪&scrPtr:= ptr;⓪&ptr:= p;⓪$END;⓪$CenterScreen⓪"END jumpPtr;⓪ ⓪ (*$l-*)⓪ PROCEDURE CondScreen(p:PROC); (* nur wenn Text verändert wurde *)⓪ BEGIN (* p=ScreenOut oder CenterScreen *)⓪ ASSEMBLER⓪(move.l -(a3),A1⓪(tst screenOK⓪(beq doit⓪(move.l ptr,a0⓪(cmpi.b #DLEchar,(a0)⓪(bne nodle⓪(addq.l #2,a0⓪(move.l a0,ptr⓪ nodle cmpa.l scrPtr,a0⓪(beq finis⓪ doit jmp (A1)⓪ finis moveq #0,d0⓪(move.b ptrY,d0⓪(move d0,ptrLine⓪ END⓪ END CondScreen;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE ChkLastPtr; (* zeigt lastPtr ausserhalb des Textes ? *)⓪ BEGIN⓪ ASSEMBLER ;benutzt a0,A1⓪(move.l lastPtr,a0⓪(move.l ptr,A1⓪(cmpa.l ptrStart,a0⓪(bcs doit⓪(cmpa.l ptrEnd,a0⓪(bhi doit⓪(move.l a0,A1⓪ doit move.l A1,lastPtr⓪ END⓪ END ChkLastPtr;⓪ ⓪ (*$l-*)⓪ PROCEDURE PushPtr;⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(move ptrCount,d0⓪(lea ptrStack,A1⓪(move d0,d1⓪(subq #4,d1⓪(andi #$3C,d1⓪(move.l a0,d2⓪(sub.l 0(A1,d1.w),d2⓪(bge noneg⓪(neg.l d2⓪ noneg cmpi.l #8,d2⓪(bcs nopush ;nicht pushen, wenn gleich dem Letzten+-8⓪(move.l a0,0(A1,d0.w)⓪(addq #4,d0⓪(andi #$3C,d0⓪ nopush move d0,ptrCount⓪ END⓪ END PushPtr;⓪ ⓪ (*$l-*)⓪ PROCEDURE ChkZap: CARDINAL; (* fⁿr Zap. Prⁿft, ob mehr als 200 *)⓪ BEGIN (* Zeichen gel÷scht werden, und ob *)⓪ ASSEMBLER ;benutzt d0,d1,d3,a0 (* Buffer ausreicht *)⓪(move.l ptr,a0⓪(move.l lastPtr,d0⓪(move.l d0,delPtr⓪(cmp.l a0,d0⓪(bhi zap1⓪(exg d0,a0⓪(move.l d0,delPtr⓪(move.l a0,ptr⓪ zap1 sub.l a0,d0⓪(move.l bufferH,d1⓪(sub.l ptrEnd,d1⓪(moveq #2,d3⓪(cmp.l d1,d0⓪(bhi zap3⓪(subq #1,d3⓪(cmp.l #200,d0⓪(bhi zap3⓪(subq #1,d3⓪ zap3 move d3,(a3)+⓪ END⓪ END ChkZap;⓪ ⓪ (*$l-*)⓪ PROCEDURE PutDir;⓪ BEGIN⓪ ASSEMBLER⓪(moveq #'>',d0⓪(tst direction⓪(beq pcdir⓪(moveq #'<',d0⓪ pcdir jmp ChrOut⓪ END⓪ END PutDir;⓪ ⓪ (*$l+*)⓪ PROCEDURE PutFrm;⓪ BEGIN⓪"WriteLCard (filesInMem);⓪"Write (' ');⓪ END PutFrm;⓪ ⓪ (*$l-*)⓪ PROCEDURE PutCmd(REF k: ARRAY OF CHAR); (* String in Statuszeile drucken *)⓪ BEGIN (* ohne Cursorpos. zu verlieren *)⓪ ASSEMBLER⓪(clr cmdFlag⓪(move ptrY,d1⓪(move.b ptrX,d1⓪(move d1,-(a7)⓪(jsr Home⓪(moveq #InverseOnChar,d0⓪(jsr ChrOut⓪(jsr PutDir⓪(TST.W tabmode⓪(BNE noFrm⓪(jsr PutFrm⓪ noFrm jsr WriteString⓪ fillup move cols,d1⓪(cmp CursorX,d1⓪(bls filled⓪(moveq #' ',d0⓪(jsr chrout⓪(bra fillup⓪ filled moveq #InverseOffChar,d0⓪(jsr ChrOut⓪(move (a7)+,d1⓪(jmp GotoXYd1⓪ END⓪ END PutCmd;⓪ ⓪ (*$l+*)⓪ PROCEDURE PutCmdOrTab(k: MAXSTR);⓪ BEGIN⓪"IF tabMode THEN⓪$Assign (TabsToStr(), k, strok);⓪$Delete (k,0,1,STROK)⓪"END;⓪"PutCmd(k)⓪ END PutCmdOrTab;⓪ ⓪ (*$l+*)⓪ PROCEDURE CmdLineAway (checkMouse: BOOLEAN): BOOLEAN;⓪"(* Statuszeile evtl. erneuern ? *)⓪"VAR c: CARDINAL;⓪&buttons: mButtonSet;⓪&Mousepoint: Point;⓪"BEGIN⓪$IF cmdFlag THEN RETURN⓪&FALSE⓪$ELSE⓪&c:= countDefault;⓪&LOOP⓪(IF KeyPressed () THEN RETURN FALSE END;⓪(GetMouseState(dev,MousePoint, buttons); (*hält Ablauf nicht an *)⓪(IF checkMouse AND (msbut1 IN buttons) THEN RETURN FALSE END;⓪(IF c = 0 THEN RETURN TRUE END;⓪(DEC (c)⓪&END⓪$END;⓪$(*⓪(ASSEMBLER⓪0moveq #0,d0⓪0tst cmdFlag⓪0bne clart⓪0move countDefault,d1⓪(wait move d1,-(a7)⓪0jsr KeyPressed⓪0move (a7)+,d1⓪0moveq #0,d0⓪0tst -(a3)⓪0dbne d1,wait⓪0bne clart⓪0moveq #1,d0⓪(clart move d0,(a3)+⓪(END⓪$*)⓪"END CmdLineAway;⓪ ⓪ (*$l-*)⓪ PROCEDURE InsCmd;⓪ BEGIN⓪"PutCmdOrTab('Insert: /F1/ or /Enter/ accepts, /ESC/ ignores')⓪ END InsCmd;⓪ ⓪ (*$l-*)⓪ PROCEDURE Overflow;⓪ BEGIN⓪"ASSEMBLER move.l A2,-(a7) END;⓪"PutCmd('Buffer overflow');Bell;ErrorWait;⓪"ASSEMBLER move.l (a7)+,A2 END⓪ END Overflow;⓪ ⓪ (*$l-*)⓪ PROCEDURE Available(bytes:INTEGER):BOOLEAN;⓪ BEGIN (* Test, ob noch <bytes> Zeichen eingefⁿgt werden k÷nnen *)⓪ ASSEMBLER ;benutzt d1,d2⓪+moveq #0,d2⓪+move -(a3),d1⓪+ext.l d1⓪+add.l bufferH,d1⓪+sub.l bufferL,d1⓪+add.l ptrEnd,d1⓪+cmp.l bufferH,d1⓪+bpl keinplatz⓪+cmp.l bufferL,d1⓪+bpl keinplatz⓪+moveq #1,d2⓪ keinplatz move d2,(a3)+⓪ END⓪ END Available;⓪ ⓪ (*$l-*)⓪ PROCEDURE MoveTags(ad:ADDRESS; cnt:LONGINT);⓪ BEGIN (* verschiebt die Tags, nachdem der Text verschoben wurde *)⓪ ASSEMBLER ;benutzt d0,d1,a0,A1,A2⓪(move.l -(a3),d0⓪(move.l -(a3),a0⓪(moveq #58,d1⓪(lea ptrStack,A1 ;tags inbegriffen⓪(tst.l d0⓪(beq adjrts⓪(bpl adjtag⓪(adda.l d0,a0⓪ adjtag move.l (A1)+,A2⓪(cmpa.l A2,a0⓪(bhi noadj⓪(adda.l d0,A2⓪(cmpa.l A2,a0⓪(bls adjt1⓪(move.l #0,A2⓪ adjt1 move.l A2,-4(A1)⓪ noadj dbf d1,adjtag⓪(move.l lastPtr,A2⓪(cmpa.l A2,a0⓪(bhi adjt2⓪(adda.l d0,A2⓪(cmpa.l A2,a0⓪(bls adjt2⓪(move.l a0,A2⓪ adjt2 move.l A2,lastPtr⓪ ;'ptr' darf hier nicht verschoben werden, weil das ggf. schon woanders passiert.⓪ adjrts⓪ END⓪ END MoveTags;⓪ ⓪ (*$l-*)⓪ PROCEDURE saveTags;⓪ BEGIN⓪ ASSEMBLER⓪(moveq #58,d1⓪(lea saveStack,A0⓪(lea ptrStack,A1⓪ adjtag move.l (A1)+,(A0)+⓪(dbf d1,adjtag⓪(move.l lastPtr,(A0)+⓪ END⓪ END saveTags;⓪ ⓪ (*$l-*)⓪ PROCEDURE restoreTags;⓪ BEGIN⓪ ASSEMBLER⓪(moveq #58,d1⓪(lea saveStack,A0⓪(lea ptrStack,A1⓪ adjtag move.l (A0)+,(A1)+⓪(dbf d1,adjtag⓪(move.l (A0)+,lastPtr⓪ END⓪ END restoreTags;⓪ ⓪ (*$l-*)⓪ PROCEDURE MoveText(ad:ADDRESS; displace:LONGINT);⓪ BEGIN (* verschiebt Text im Speicher ab Adresse ad um displace *)⓪ ASSEMBLER ;benutzt d0,d1,a0,A1,A2⓪(move.l -4(a3),d0 ;displace⓪(move.l -8(a3),A1 ;ad ! Parameter bleiben auf Stack !⓪(move.l ptrEnd,a0⓪(tst.l d0⓪(beq movrts⓪(clr saved⓪(clr restoreFileDT⓪(clr screenOK⓪(⓪(lea 0(A1,d0.l),A2⓪(add.l d0,ptrEnd⓪(; A1: source-Start, A2: dest-Start⓪(MOVE.L D2,-(A7)⓪(MOVE.L A1,(A3)+⓪(SUBA.L A1,A0 ;Länge = ptrEnd - start⓪(ADDQ.L #1,A0⓪(MOVE.L A0,(A3)+⓪(MOVE.L A2,(A3)+⓪(JSR Block.Copy⓪(MOVE.L (A7)+,D2⓪ movrts jmp MoveTags⓪ END⓪ END MoveText;⓪ ⓪ (*$l-*)⓪ PROCEDURE BufferToText(copyDLE: BOOLEAN);⓪ BEGIN (* kopiert den Buffer-Inhalt an die Textstelle *)⓪ ASSEMBLER⓪*move.l bufferH,d4⓪*sub.l bufferL,d4⓪*bgt bok1⓪*beq bleer1⓪ bleer move.l bufferH,bufferL END;⓪*PutCmd('Buffer bad'); ASSEMBLER⓪*jsr Bell⓪*jsr ErrorWait⓪ bleer1 bra bnix⓪ bok1 clr (a3)+⓪*jsr Available⓪*tst -(a3)⓪*beq bleer⓪*move.l bufferH,d3⓪*sub.l bufferL,d3⓪*ble bnix⓪*move.l d3,-(a7)⓪*move.l ptr,(a3)+⓪*move.l d3,(a3)+⓪*jsr MoveText⓪*move.l ptr,A1⓪*move.l bufferH,a0⓪*move.l (a7)+,d3⓪ rein move.b -(a0),(A1)+⓪*subq.l #1,d3⓪*bgt rein⓪*move.l ptr,a0⓪*move.l A1,ptr⓪*tst -2(a3) ;copyIt? bei Insert keinen DLE kopieren⓪*beq bnix⓪*jsr LineSt⓪*cmpi.b #DLEchar,(a0)⓪*bne bnix⓪*cmpi.b #DLEchar,-2(A1)⓪*bne bnix⓪*move.b 1(a0),-1(A1)⓪ bnix subq.l #2,a3⓪ END⓪ END BufferToText;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelInBuffer; (* bei Delete: falls ESC gedrⁿckt wurde *)⓪ BEGIN⓪ ASSEMBLER ;benutzt d1,a0,A2⓪(move.l ptr,d1⓪(move.l delPtr,a0⓪(cmp.l a0,d1⓪(bcc lolehi⓪(exg a0,d1⓪ lolehi move.l bufferH,A2⓪(cmp.l a0,d1⓪(beq dnixin⓪ abinb move.b (a0)+,-(A2)⓪(cmp.l a0,d1⓪(bhi abinb⓪ dnixin move.l A2,bufferL⓪ END⓪ END DelInBuffer;⓪ ⓪ (*$l-*)⓪ PROCEDURE AbInBuffer; (* delPtr-ptr in Buffer, dann l÷schen *)⓪ BEGIN (* egal ob delPtr>ptr oder delPtr<ptr *)⓪ ASSEMBLER ;benutzt d0,a0,A1⓪(jsr DelInBuffer ;in A2 steht noch bufferL⓪(move.l ptr,a0⓪(move.l delPtr,A1⓪(move.l A1,d0⓪(sub.l a0,d0⓪(bmi aib1⓪(exg A1,a0⓪(neg.l d0 ;a0 ist h÷here Adresse⓪ aib1 cmpi.b #DLEchar,-2(a0) ;letzter mitgel÷schter DLE-Code⓪(bne aib2⓪(cmpi.b #DLEchar,-2(A1) ;DLE vor gel. Bereich⓪(bne aib2⓪(move.b -1(a0),-1(A1) ;DLE-Code kopieren⓪ aib2 move.l a0,(a3)+⓪(move.l d0,(a3)+⓪(jmp MoveText⓪ END⓪ END AbInBuffer;⓪ ⓪ (* ED4.ICL *)⓪ ⓪ (*$l-*)⓪ PROCEDURE IncrementVersion (): Strings.String;⓪ BEGIN⓪ ASSEMBLER⓪(clr.b (a3)⓪(lea 80(A3),A3⓪(move.l ptrStart,a0⓪ fndlp move.b (a0)+,d0⓪(beq xit⓪(cmpi.b #'V',d0⓪(beq fndV⓪(cmpi.b #DLEchar,d0⓪(bne fndlp⓪(addq.l #1,a0⓪(bra fndlp⓪ fndV cmpi.b #'#',(a0)+⓪(bne fndlp⓪(move.l a0,A1⓪ fnddig move.b (a0)+,d0⓪(cmpi.b #'0',d0⓪(bcs incr⓪(cmpi.b #'9',d0⓪(bls fnddig⓪ incr subq.l #1,a0⓪(lea -1(a0),A2⓪ incrlp move.b -(a0),d0⓪(cmpa.l a0,A1⓪(bhi wrt⓪(clr saved⓪(clr restoreFileDT⓪(addq.b #1,d0⓪(cmpi.b #'9',d0⓪(bls incrxt⓪(move.b #'0',(a0)⓪(bra incrlp⓪ incrxt move.b d0,(a0)⓪ wrt lea -80(A3),A0⓪(move.b #'V',(a0)+⓪(move.b #'#',(a0)+⓪ wrtlp move.b (A1)+,(a0)+⓪(cmpa.l A1,A2⓪(bcc wrtlp⓪(clr.b (a0)⓪ xit⓪ END⓪ END IncrementVersion;⓪ ⓪ (*$l-*)⓪ PROCEDURE Exchg(ch:CHAR): BOOLEAN;(* ein Zeichen an Textstelle schreiben *)⓪ BEGIN⓪ ASSEMBLER ;benutzt d0,a0⓪(move -(a3),-(a7)⓪(move.l ptr,a0⓪(move.b (a0),d0⓪(beq ins0⓪(cmpi.b #CRchar,d0⓪(bne ok⓪ ins0 moveq #0,d0⓪(move #1,(a3)+⓪(jsr Available⓪(tst -(a3)⓪(beq nonono⓪(move.l ptr,(a3)+⓪(move.l #1,(a3)+⓪(jsr MoveText⓪ ok moveq #1,d0⓪(clr saved⓪(clr restoreFileDT⓪(move.l ptr,a0⓪(move.b (a7),(a0)+⓪(move.l a0,ptr⓪ nonono move d0,(a3)+⓪(addq.l #2,a7⓪ END⓪ END Exchg;⓪ ⓪ (*$l-*)⓪ PROCEDURE FillIn(ad:ADDRESS; VAR n:STRING); (* String an ad einspeichern *)⓪ BEGIN⓪ ASSEMBLER ;benutzt d0,a0,A1⓪(move.l -(a3),a0⓪(move.l -(a3),A1⓪(move.b (a0)+,d0⓪(beq nofill⓪ lbl move.b d0,(A1)+⓪(move.b (a0)+,d0⓪(bne lbl⓪(clr saved⓪(clr restoreFileDT⓪(clr screenOK⓪ nofill⓪ END⓪ END FillIn;⓪ ⓪ (*$l-*)⓪ PROCEDURE Search(): BOOLEAN; (* findet Auftreten von oldString im Text *)⓪ BEGIN (* delPtr zeigt auf erstes Zeichen, ptr dahinter *)⓪ ASSEMBLER ;benutzt d0-d7,a0-A6⓪+movem.l d3-d7,-(a7) ;die movem müssen wg. D6 am Ende getrennt sein!⓪+movem.l A6/a3/a4,-(a7)⓪+link A5,#0⓪+moveq #0,d6 ;d6=BOOLEAN-Ergebnis⓪+lea oldString,A1⓪+moveq #0,d4⓪+move.b (A1)+,d4 ;d4=Length(oldString)⓪+beq.l srchrts⓪+move.l ptr,a0 ;a0=Text-Pointer⓪+lea getplus(pc),A6⓪+lea getoldp(pc),a4⓪+tst direction ;true=rückwärts⓪+beq dok⓪+lea getmin(pc),A6⓪+lea getoldm(pc),a4⓪+adda d4,A1⓪ dok moveq #0,d0 ;obere Bytes von D0 löschen⓪+moveq #0,d3 ;obere Bytes von D3 löschen⓪+; ** das 1. gesuchte Zeichen auf den Stack **⓪+lea NormTab,a3⓪+lea anum2(PC),a2⓪+jsr (a4) ;erstes suchzeichen nach D3/D7⓪+move.l a1,-(A7)⓪+move d3,d7⓪+tst findCase ;Case-Sensitivity-Flag⓪+bne csens⓪+lea ShiftTab,a3⓪+move.b 0(a3,d3.w),d7 ;upper case⓪+addi.w #256,d3⓪+move.b 0(a3,d3.w),d3 ;lower case⓪+andi #255,D3⓪ csens move.w d7,-(a7)⓪+move.b d3,(a7)⓪+tst findWord⓪+bne wsrch⓪+bra.w srchneu⓪ ⓪ ; ***** Ende der Suchvorbereitung *****⓪ ⓪ getmin move.b -(a0),d0⓪+beq.l srchrts⓪+cmpi.b #DLEchar,-1(a0)⓪+bne getmin1⓪+subq.l #1,a0⓪+move.l a0,delPtr⓪+bra getmin⓪ getmin1 rts⓪ ⓪ getplus move.b (a0)+,d0⓪+beq.l srchrts⓪+cmpi.b #DLEchar,d0⓪+bne getplus1⓪+addq.l #1,a0⓪+move.l a0,delPtr⓪+bra getplus⓪ getplus1 rts⓪ ⓪ getoldm move.b -(A1),d3⓪+move.b 0(a3,d3.w),d3 ;upper case⓪+rts⓪ getoldp move.b (A1)+,d3⓪+move.b 0(a3,d3.w),d3 ;upper case⓪+rts⓪ ⓪ ; * wortweise *⓪ ⓪ wsrch move.l 2(a7),A1 ;A1=Zeiger in oldString⓪+move d4,d5 ;Schleifenzähler⓪+move.b (a7),d3⓪+move.b 1(a7),d7⓪+tst direction ;true=rückwärts⓪+beq forw3⓪ ⓪ back3 ; erstmal alle AlphaNums überspringen⓪+move.b -(a0),d0⓪+TST.B 0(A2,D0.W) ;AlphaNum?⓪+beq back3 ;ja⓪+bpl back4⓪+tst.b d0⓪+bne back3 ;muß DLE gewesen sein - weiter⓪+bra.w srchrts⓪ back4 ;dies zeichen kann noch übersprungen werden, weil es ja kein⓪+;alpha-zeichen ist, dahinter suchen wir wortanfang⓪+move.b -(a0),d0⓪+TST.B 0(A2,D0.W) ;AlphaNum?⓪+beq back5 ;ja⓪+bpl back4⓪+tst.b d0⓪+bne back4 ;muß DLE gewesen sein - weiter⓪+bra.w srchrts⓪ back5 ;wortanfang - stimmt 1. zeichen?⓪+cmp.b d3,d0⓪+beq.w found1⓪+cmp.b d7,d0⓪+bne back3 ;stimmt nicht - wieder zum wortende⓪+bra.w found1⓪ ⓪ forw3 ; erstmal alle AlphaNums überspringen⓪+move.b (a0)+,d0⓪+TST.B 0(A2,D0.W) ;AlphaNum?⓪+beq forw3 ;ja - weitersuchen⓪+bpl forw2 ;nein⓪+tst.b d0⓪+beq.w srchrts⓪+;muß DLE gewesen sein. Überspringen und weiter wie nicht-AlphaNum⓪+addq.l #1,a0⓪ forw2 ;dies zeichen kann noch übersprungen werden, weil es ja kein⓪+;alpha-zeichen ist, dahinter suchen wir wortanfang⓪+move.b (a0)+,d0⓪+TST.B 0(A2,D0.W) ;AlphaNum?⓪+beq forw5 ;ja -> wortanfang gefunden⓪+bpl forw2 ;nein, weiter nach anfang suchen⓪+tst.b d0⓪+beq.w srchrts⓪+;muß DLE gewesen sein⓪+addq.l #1,a0⓪+bra forw2⓪ forw5 ;wortanfang - stimmt 1. zeichen?⓪+cmp.b d3,d0⓪+beq.w found1⓪+cmp.b d7,d0⓪+bne forw3 ;stimmt nicht - wieder zum wortende⓪+bra.w found1⓪ ⓪ ; * normal suchen *⓪ ⓪ srchneu move.l 2(a7),A1 ;A1=Zeiger in oldString⓪+move d4,d5 ;Schleifenzähler⓪+; ** das 1. Zeichen wird schneller gesucht **⓪+move.b (a7),d3⓪+move.b 1(a7),d7⓪+tst direction ;true=rückwärts⓪+beq forw1⓪ back1 ; rückw. suchen⓪+move.b -(a0),d0⓪+beq.l srchrts⓪+cmp.b d3,d0⓪+beq backfnd⓪+cmp.b d7,d0⓪+bne back1⓪ backfnd cmpi.b #DLEchar,-1(a0) ; ist ein DLE davor?⓪+beq back1 ; dann haben wir uns geirrt⓪+bra found1⓪ forw1 ; vorw. suchen⓪+move.b (a0)+,d0⓪+beq.l srchrts⓪+cmp.b d3,d0⓪+beq forwfnd⓪+cmp.b d7,d0⓪+bne forw1⓪ forwfnd cmpi.b #DLEchar,-2(a0) ; war ein DLE davor?⓪+beq forw1 ; dann haben wir uns geirrt⓪ ⓪ found1 ; gefunden⓪+move.l a0,delPtr⓪+subq #1,d5⓪+beq found2⓪ ⓪+; jetzt die restlichen Zeichen vergleichen⓪ srchmore jsr (A6) ;getbyte⓪+move.b 0(a3,d0.w),d0 ;upper case⓪+jsr (a4) ;getold⓪+cmp.b d0,d3⓪+bne srchmism⓪+subq #1,d5⓪+bne srchmore⓪ ⓪ found2 move.l a0,A1⓪+tst findWord⓪+beq found3⓪+move.l delPtr,-(A7)⓪+jsr (A6) ;getbyte⓪+move.l (A7)+,delPtr⓪+TST.B 0(A2,D0.W) ;AlphaNum?⓪+beq wsrch ;ja⓪ found3 moveq #1,d6 ;Erfolg⓪+move.l A1,ptr⓪+tst direction ;true=rückwärts⓪+bne.w srchrts⓪+subq.l #1,delPtr⓪+bra.w srchrts⓪ ⓪ srchmism move.l delPtr,a0⓪+tst findWord⓪+bne wsrch⓪+bra srchneu⓪ ⓪ anum2 ; Alphanum-Tab, -1 bei Null und DLE⓪(DC.B -1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B -1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0⓪(DC.B 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0⓪(DC.B 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1⓪(DC.B 0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1⓪(DC.B 0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1⓪ ⓪+; Suchende⓪ ⓪ srchrts unlk A5⓪+movem.l (a7)+,A6/a3/a4⓪+move d6,(a3)+⓪+movem.l (a7)+,d3-d7⓪ END⓪ END Search;⓪ ⓪ (*$l+*)⓪ PROCEDURE ChkName(VAR n:STRING): BOOLEAN;⓪"VAR p,l:INTEGER;⓪ BEGIN (* evtl. '.TXT' anhängen *)⓪"Upper(n);⓪"IF Empty (FileNames.FileName(n)) THEN⓪$n:=''; RETURN false⓪"ELSE⓪$(* dies muß raus, da sonst keine Dateien ohne Suffix geladen werden können:⓪&p := Pos('.',n,0);⓪&IF p<0 THEN⓪(Concat(n,'.TXT',n,strok)⓪&END⓪$*)⓪"END;⓪"RETURN true⓪ END ChkName;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE PutInfo; (* den infoBlock zum Abspeichern fⁿllen *)⓪ BEGIN⓪ ASSEMBLER ;benutzt d0,d1,d2,a0,A1⓪(⓪(lea infobuffer,A1⓪(move.l #$0d0a282A,(A1)+⓪(MOVE.B #' ',(A1)+⓪(bra cont⓪(⓪ putlcard⓪(move.l d2,(a3)+⓪(move #9,(a3)+⓪(movem.l d0/d1/a0/A1,-(a7)⓪(jsr lhextostr⓪(movem.l (a7)+,d0/d1/a0/A1⓪(lea -80(a3),A2⓪(moveq #8,d2⓪ putl1 move.b (A2)+,(A1)+⓪(dbra d2,putl1⓪(lea -80(a3),a3⓪(rts⓪(⓪ putch ori.b #$80,d0⓪(move.b d0,(A1)+⓪(rts⓪(⓪ cont lea tags,a0⓪(move.l ptrStart,d1⓪(moveq #41,d0⓪ coptag move.l (a0)+,d2⓪(sub.l d1,d2⓪(bsr putlcard⓪(dbf d0,coptag⓪(⓪(move findCase,d0⓪(bsr putch⓪(⓪(move.l lastPtr,d2⓪(sub.l d1,d2⓪(bsr putlcard⓪(⓪(movem.l d0/d1/a0/A1,-(a7)⓪(jsr tabsToStr⓪(movem.l (a7)+,d0/d1/a0/A1⓪(lea -82(a3),a0⓪(moveq #79,d0⓪ coptab move.b (a0)+,(A1)+⓪(dbf d0,coptab⓪(lea -82(a3),a3⓪(⓪(lea ptrStack,a0⓪(moveq #15,d0⓪ ctag2 move.l (a0)+,d2⓪(sub.l d1,d2⓪(bsr putlcard⓪(dbf d0,ctag2⓪(⓪(move ptrCount,d0⓪(bsr putch⓪(move autoBack,d0⓪(bsr putch⓪(move autoIncVer,d0⓪(move leaveDLEonWrite,D1⓪(LSL #1,D1⓪(OR D1,D0⓪(bsr putch⓪(MOVE.L #$2A290D0A,(A1)+⓪(moveq #20,d0⓪ clrl move.b #'.',(A1)+⓪(dbra d0,clrl⓪ END⓪ END PutInfo;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE CleanText;⓪ BEGIN⓪ ASSEMBLER⓪(JSR savetags⓪(TST makeDLE⓪(BEQ.L rmdo⓪ ⓪(; neuer Text, DLE einfügen⓪ ⓪(; zuerst die Verschiebungen berechnen⓪ spdo MOVE.L ptrStart,A1⓪(MOVE.L A1,A2⓪(MOVE.L ptrEnd,D2⓪(SUB.L A1,D2⓪(MOVEQ #0,D3⓪ ⓪ spdln MOVEQ #2,D1⓪ ⓪ spdcnt CMPI.B #' ',(A1)⓪(BNE spdmo⓪(ADDQ.L #1,A1⓪(SUBQ.L #1,D1⓪(ADDQ.L #1,A2⓪(SUBQ.L #1,D2⓪(BRA spdcnt⓪ ⓪ spdmo CMPI.B #DLEchar,(A1)⓪(BNE spdmo1⓪ ⓪(SUBQ.L #2,D2⓪(SUBQ.L #2,D1⓪(MOVEQ #0,D3⓪(ADDQ.L #2,A1⓪(ADDQ.L #2,A2⓪ ⓪ spdmo1 CMPA.L bufferL,A2⓪(BLS spdmo2⓪(JSR overflow⓪(JMP restoretags⓪ spdmo2 MOVE.L A2,(A3)+⓪(ADD.L D1,D3⓪(MOVE.L D3,(A3)+⓪(ADDA.L D3,A2⓪(MOVEM.L D1/D2/A1/A2,-(A7)⓪(JSR MoveTags⓪(MOVEM.L (A7)+,D1/D2/A1/A2⓪(MOVEQ #0,D3⓪ spnex SUBQ.L #1,D2⓪(ADDQ.L #1,A2⓪(MOVE.B (A1)+,D0⓪(CMPI.B #$0D,D0⓪(BEQ spdlx⓪(CMPI.B #$0A,D0⓪(BEQ spd00⓪(CMPI.B #' ',D0⓪(BNE sptr⓪(SUBQ.L #1,D3⓪(BRA spcr⓪ sptr MOVEQ #0,D3⓪ spcr TST.L D2⓪(BPL spnex⓪(⓪(BRA spcdo ; Fertig⓪(⓪ spdlx CMPI.B #$0A,(A1)⓪(BNE spd00⓪(⓪(SUBQ.L #1,D2⓪(ADDQ.L #1,A2⓪(ADDQ.L #1,A1⓪(SUBQ.L #1,D3⓪ spd00 TST.L D2⓪(BPL spdln⓪ ⓪(; jetzt den Text hochkopieren⓪ spcdo MOVE.L ptrEnd,A0⓪(MOVE.L BufferL,A1⓪(SUBQ.L #2,A1⓪(MOVE.L A0,D0⓪(SUB.L ptrStart,D0⓪(MOVE.L D0,D2⓪(MOVE.L A1,A2⓪(SUBA.L D0,A2⓪(ADDQ.L #1,A0⓪(ADDQ.L #1,A1⓪(SWAP D0⓪ spcdom1 SWAP D0⓪ spcdomv MOVE.B -(A0),-(A1)⓪(DBF D0,spcdomv⓪(SWAP D0⓪(DBF D0,spcdom1⓪(⓪(; zuletzt Zurückkopieren mit Korrektur der Codes⓪(; D2: Anzahl Source-Bytes⓪(; A0: Pufferbeginn (dest)⓪(; A1: Textbeginn (source)⓪(MOVEQ #0,D3⓪ spcdln MOVEQ #DLEoffset,D1⓪(TST.W D3⓪(BEQ spcdcnt⓪(LEA -1(A0,D3.W),A0⓪(MOVE.B #$0D,(A0)+⓪(MOVEQ #0,D3⓪ spcdcnt CMPI.B #' ',(A1)⓪(BNE spcdmo⓪(ADDQ.L #1,A1⓪(ADDQ.B #1,D1⓪(SUBQ.L #1,D2⓪(BRA spcdcnt⓪ spcdmo CMPI.B #DLEchar,(A1)⓪(BNE spcdle⓪(SUBQ.L #2,D2⓪(MOVEQ #0,D3⓪(ADDQ.L #1,A1⓪(MOVE.B (A1)+,D0⓪(SUBI.B #DLEoffset,D0⓪(BLE spcdle⓪(ADD.B D0,D1⓪ spcdle MOVE.B #DLEchar,(A0)+⓪(MOVE.B D1,(A0)+⓪ spcnex SUBQ.L #1,D2⓪(MOVE.B (A1)+,D0⓪(BEQ spccr⓪(CMPI.B #$0A,D0⓪(BEQ iscr⓪(CMPI.B #$0D,D0⓪(BNE notCR⓪(CMPI.B #$0A,(A1)⓪(BNE isCR⓪(SUBQ.L #1,D2⓪(ADDQ.L #1,A1⓪ isCR MOVEQ #$0D,D0⓪ notCR CMPI.B #$09,D0⓪(BNE notTAB⓪(MOVEQ #'§',D0⓪ notTAB MOVE.B D0,(A0)+⓪(CMPI.B #$0D,D0⓪(BEQ spcdlx⓪(CMPI.B #' ',D0⓪(BNE spctr⓪(SUBQ.W #1,D3⓪(BRA spccr⓪ spctr MOVEQ #0,D3⓪ spccr TST.L D2⓪(BGE spcnex⓪(TST.W D3⓪(BEQ spce0⓪(LEA 0(A0,D3.W),A0⓪(BRA spce0⓪ spcdx TST.W D3⓪(BEQ spce0⓪(LEA -1(A0,D3.W),A0⓪(MOVE.B #$0D,(A0)+⓪(MOVEQ #0,D3⓪ spce0 CLR.B (A0)+⓪(CLR.B (A0)+⓪(MOVE.L A0,ptrEnd⓪(CLR.B (A0)+⓪(CLR.B (A0)+⓪(CLR.B (A0)+⓪(CLR.B (A0)+⓪(RTS⓪ spcdlx TST.L D2⓪(BGE spcdln⓪(BRA spcdx⓪ ⓪(; text speichern: DLE löschen⓪ rmdo MOVE.L ptrStart,A1⓪(MOVE.L A1,A2⓪(MOVE.L ptrEnd,D2⓪(SUB.L A1,D2⓪(MOVEQ #1,D3⓪ rldln ADDQ.L #1,A2⓪(MOVE.B (A1)+,D0⓪(CMPI.B #DLEchar,D0⓪(BNE rldld⓪(ADDQ.L #1,A2⓪(SUBQ.L #1,D2⓪(MOVEQ #0,D0⓪(MOVE.B (A1)+,D0⓪(SUBI.B #DLEoffset,D0⓪(BPL ok⓪(MOVEQ #0,D0⓪ ok SUBQ.L #1,D0⓪(SUB.L D3,D0⓪(CMPA.L bufferL,A2⓪(BLS spdmo3⓪(JSR overflow⓪(JMP restoretags⓪ spdmo3 MOVE.L A2,(A3)+⓪(MOVE.L D0,(A3)+⓪(ADDA.L D0,A2⓪(MOVEM.L A1/A2,-(A7)⓪(JSR MoveTags⓪(MOVEM.L (A7)+,A1/A2⓪(MOVEQ #0,D3⓪ rldld SUBQ.L #1,D2⓪(BGE rldln⓪(; Fertig mit Tag-Korrektur⓪(MOVE.L ptrEnd,A0⓪(MOVE.L BufferL,A1⓪(SUBQ.L #2,A1⓪(MOVE.L A0,D0⓪(SUB.L ptrStart,D0⓪(MOVE.L D0,D2⓪(MOVE.L A1,A2⓪(SUBA.L D0,A2⓪(ADDQ.L #1,A0⓪(ADDQ.L #1,A1⓪(SWAP D0⓪ rmdom1 SWAP D0⓪ rmdomv MOVE.B -(A0),-(A1)⓪(DBF D0,rmdomv⓪(SWAP D0⓪(DBF D0,rmdom1⓪ rmdln MOVE.B (A1)+,D0⓪(CMPI.B #$0D,D0⓪(BNE notCR2⓪(MOVE.B D0,(A0)+⓪(MOVEQ #$0A,D0⓪ notCR2 CMPI.B #DLEchar,D0⓪(BEQ rmdcnt⓪(MOVE.B D0,(A0)+⓪ rmdld SUBQ.L #1,D2⓪(BGE rmdln⓪ rmdx SUBQ.L #1,A0⓪(MOVE.L A0,ptrEnd⓪ rmex RTS⓪ rmdcnt MOVE.B (A1)+,D0⓪(SUBQ.L #1,D2⓪(SUBI.B #DLEoffset,D0⓪ rmdspc BLE rmdld⓪(MOVE.B #' ',(A0)+⓪(SUBQ.B #1,D0⓪(BRA rmdspc⓪ END⓪ END CleanText;⓪ ⓪ (*$l+*)⓪ PROCEDURE WriteText: BOOLEAN;⓪"VAR oldend: POINTER TO CHAR; blockAnz, lastInBl, ioerr : Cardinal;⓪&oldch: CHAR;⓪ BEGIN⓪"IF saveinfo THEN⓪$tags['=']:= ptrEnd;⓪$tags[';']:= ptr;⓪"END;⓪"IF makeDLE & NOT leaveDLEonWrite THEN⓪$makeDLE := False; Cleantext⓪"END;⓪"oldend:= ptrend-2L;⓪"oldch:= oldend^;⓪"oldend^:= CHR (26); (* Ctrl-Z *)⓪"IF saveinfo THEN⓪$INC (ptrend);⓪$IF odd (ptrend-ptrstart) THEN⓪&inc (ptrend)⓪$END;⓪"END;⓪"WriteBytes (f,ptrStart,ptrend-ptrstart-2L);⓪"oldend^:= oldch;⓪"ptrend:= ADDRESS (oldend)+2L;⓪"IOResult := State (f);⓪"IF saveinfo & (ioresult >= 0) THEN⓪$PutInfo;⓪$WriteBytes (f,adr(infobuffer),long(infoLen));⓪$IOResult := State (f);⓪"END;⓪"tags['=']:= ptrStart;⓪"tags[';']:= ptrStart;⓪"ResetState(f);⓪"Close(f);⓪"ioerr := State (f);⓪"IF SuccessFull(1) THEN⓪$IOResult := ioerr;⓪$IF SuccessFull(3) THEN⓪&saved:=true;⓪&RETURN true⓪$END⓪"END;⓪"RETURN false⓪ END WriteText;⓪ ⓪ VAR fullDate: Date; fullTime: Time;⓪ ⓪ PROCEDURE GetDT;⓪"BEGIN⓪$GetDateTime (f, fullDate, fullTime);⓪$fileD:= PackDate (fullDate);⓪$fileT:= PackTime (fullTime)⓪"END GetDT;⓪ ⓪ (*$l+*)⓪ PROCEDURE SaveText(VAR fn:STRING; sBack, sWarn, keepTime:BOOLEAN):BOOLEAN;⓪"VAR createTime, createDate:CARDINAL; gotOld:BOOLEAN; bp, be, bf:STRING;⓪ BEGIN⓪"IF autoIncVer & NOT saved & NOT restoreFileDT THEN⓪$WriteString (IncrementVersion())⓪"END;⓪"WriteLn;⓪"Open (f,fn,readonly);⓪"IOResult := State(f);⓪"gotOld:=IOResult>=0;⓪"IF gotOld THEN⓪$Close (f);⓪$IF sWarn THEN⓪&WriteString('File already exists. Overwrite it?');⓪&IF NOT Yes() THEN RETURN false END;⓪&WriteLn⓪$END;⓪$IF sBack OR autoBack THEN⓪&WriteString('Backing up...');WriteLn;⓪&bf:=fn;⓪&SplitPath (bf, bf, bp);⓪&SplitName (bp, bp, be);⓪&Append (bp, bf, strok);⓪&Append('.BAK',bf,strok);⓪&ioresult:= FDelete (ADR(bf));⓪&ioresult:= Rename (ADR(fn),ADR(bf));⓪&IF NOT SuccessFull(7) THEN RETURN false END⓪$END;⓪$ioresult:= FDelete (ADR(fn));⓪"END;⓪"Create (f,fn,writeonly,noreplace);⓪"IOResult := State (f);⓪"IF SuccessFull(9) THEN⓪$WriteString('Writing ');WriteString(fn); WriteLn;⓪$IF WriteText () THEN⓪&Open (f,fn,readonly);⓪&IF restoreFileDT OR keepTime THEN⓪(fullDate:= UnpackDate (fileD);⓪(fullTime:= UnpackTime (fileT);⓪(SetDateTime (f, fullDate, fullTime);⓪&ELSE⓪(GetDT⓪&END;⓪&Close (f);⓪&RETURN TRUE⓪$ELSE⓪&IF sBack OR autoBack THEN⓪(ioresult:= FDelete (ADR(fn));⓪(ioresult:= Rename (ADR(bf),ADR(fn));⓪&END;⓪$END⓪"END;⓪"RETURN false⓪ END SaveText;⓪ ⓪ (*$l-*)⓪ PROCEDURE GetInfo; (* Marker usw. aus infoBlock holen *)⓪ BEGIN⓪ ASSEMBLER⓪(movem.l a0/A1/d0/d1/d2/d3/d4/d5/d6,-(a7)⓪(CLR saveinfo⓪(clr leaveDLEonWrite ; damit ReadText nix falsch macht⓪(BRA cont⓪(⓪ getlcard⓪(move.l a1,-(a7)⓪(lea printline,a1⓪(move.l a1,(a3)+⓪(moveq #8,D3⓪(move d3,(a3)+⓪ copstr move.b (a0)+,(a1)+⓪(dbra d3,copstr⓪(clr.b (a1)⓪(clr.w -(a7)⓪(move.l a7,(a3)+⓪(clr.w -(a7)⓪(move.l a7,(a3)+⓪(movem.l d0/d1/a0/a2,-(a7)⓪(jsr strtolcard⓪(movem.l (a7)+,d0/d1/a0/a2⓪(addq.l #4,a7⓪(move.l (a7)+,a1⓪(move.l -(a3),d2⓪(rts⓪(⓪ cont LEA -infoLen(A2),A0⓪(CMPA.L ptrStart,A0⓪(BLS.W noget⓪(MOVE.L A0,D0⓪(CMPI.B #$0D,(A0)+⓪(BNE.L noget⓪(CMPI.B #$0A,(A0)+⓪(BNE.L noget⓪(CMPI.B #'(',(A0)+⓪(BNE.L noget⓪(CMPI.B #'*',(A0)+⓪(BNE.L noget⓪(CMPI.B #' ',(A0)+⓪(BNE.L noget⓪(⓪(MOVE.L D0,A2⓪(⓪((*⓪*MOVE.L ptrStart,A1⓪*CMPI.B #DLEchar,(a1)⓪*BNE.W noget ; Es ist eine Info da, aber wir ignorieren sie⓪(*)⓪(⓪(; Die tags werden erstmal in einen Kopierpuffer geladen und erst⓪(; am Ende, wenn sicher ist, daß die Infoline noch aktuell ist,⓪(; per restoreTags in den richtigen Puffer übertragen.⓪(⓪(lea svs2,A1⓪(move.l ptrStart,d1⓪(moveq #41,d0⓪ coptag bsr getlcard⓪(add.l d1,d2⓪(move.l d2,(A1)+⓪(dbf d0,coptag⓪(⓪(move.b (a0)+,d0⓪(andi #1,d0⓪(move d0,findCase⓪(⓪(bsr getlcard⓪(add.l d1,d2⓪(move.l d2,svlptr⓪(⓪(moveq #79,d0⓪ coptab move.b (a0)+,(a3)+⓪(dbf d0,coptab⓪(clr.w (a3)+⓪(movem.l d0-d2/a0-A2,-(a7)⓪(jsr gettabs⓪(movem.l (a7)+,d0-d2/a0-A2⓪(⓪(lea saveStack,A1⓪(moveq #15,d0⓪ ctag2 bsr getlcard⓪(add.l d1,d2⓪(move.l d2,(A1)+⓪(dbf d0,ctag2⓪(⓪(move.b (a0)+,d0⓪(andi #$3C,d0⓪(move d0,ptrCount⓪(⓪(move.b (a0)+,d0⓪(andi #1,d0⓪(move d0,autoBack⓪(⓪(move.b (a0)+,d0⓪(move d0,d1⓪(andi #1,d0⓪(move d0,autoIncVer⓪(lsr #1,d1⓪(andi #1,d1⓪(move d1,leaveDLEonWrite⓪(⓪(; Konsistenzprüfung der Infoline:⓪(; tags['='] muß identisch mit ptrEnd sein⓪ ⓪(MOVE #1,saveinfo⓪ ⓪ noGet movem.l (a7)+,a0/A1/d0/d1/d2/d3/d4/d5/d6⓪ END⓪ END GetInfo;⓪ ⓪ (*$l-*)⓪ PROCEDURE GetFile; (* file laden *)⓪ BEGIN⓪"ASSEMBLER⓪.move.l flen,d0⓪.move.l d0,d5⓪.add.l A2,d0⓪.move.l d0,d6 ;VORRAUSSICHTLICHES TEXTENDE⓪.tst.l d5⓪.beq nullget⓪.addi.l #$100,d0⓪.cmp.l hilf,d0⓪.blt blockok⓪.jsr Overflow⓪.move #-1,ioresult⓪.bra.w lesende⓪"blockok MOVE.L f,(A3)+⓪.MOVE.L A2,(A3)+⓪.MOVE.L D5,(A3)+⓪.clr.l -(a7)⓪.move.l a7,(a3)+⓪.movem.l A1/A2/d0/d1/d2,-(a7)⓪.JSR ReadBytes⓪.MOVE.L f,(A3)+⓪.JSR State⓪.MOVE -(A3),IOResult⓪.move #11,(a3)+⓪.jsr SuccessFull⓪.movem.l (a7)+,A1/A2/d0/d1/d2⓪.addq.l #4,a7⓪ ⓪.tst -(a3)⓪.beq.S lesende⓪ ⓪+nullget⓪.movea.l d6,A1⓪.clr.b (A1)⓪.move.l A1,A2⓪.⓪"lesende move.l A2,-(a7)⓪"END;⓪"IF State (f) >= 0 THEN⓪$GetDT;⓪"END;⓪"ResetState(f);⓪"Close(f);⓪"ASSEMBLER movea.l (a7)+,A2⓪"END⓪ END GetFile;⓪ ⓪ (*$l-*)⓪ PROCEDURE ReadText; (* File von Diskette laden und aufbereiten *)⓪ BEGIN (* alle Text-Pointer setzen *)⓪ ASSEMBLER⓪(clr.w saveinfo⓪(move.l bufferL,hilf⓪(move.l ptrStart,A2 ;ZEIGER LESEN⓪(move.l A2,ptr⓪(move.l a2,-(a7)⓪(jsr ResetTextOptions⓪(move.l (a7)+,a2⓪(jsr GetFile⓪(tst IOResult⓪(bmi.w noload⓪(TST.L D5⓪(; BEQ.W noload⓪(beq skipeot⓪(jsr getinfo⓪ look40 move.b -(a2),d0⓪(beq look40⓪(cmpi.b #26,d0 ; ctrl-z⓪(beq skipeot⓪(addq.l #1,a2⓪ skipeot clr.b (A2)+⓪(clr.b (A2)+⓪(move.l A2,ptrEnd⓪(TST.W saveinfo⓪(BEQ noinfo⓪(lea svs2,a1 ; Kopie v. 'tags'⓪(cmpa.l $34(a1),a2 ; tags['='] = ptrEnd?⓪(beq infook⓪(move.l $34(a1),d0 ; tags['='] überhaupt definiert?⓪(MOVE.L ptrStart,A1⓪(cmp.l a1,d0⓪(bcs chkold ; nein -> auf DLE prüfen⓪(cmp.l a2,d0 ; (A2=ptrEnd)⓪(bcs noinfo ; ja -> info nicht mehr gültig⓪ chkold CMPI.B #DLEchar,(a1)⓪(bne noinfo ; bei alten Texten ist DLE das Kriterium⓪ infook MOVE.W #1,saveinfo⓪(JSR restoreTags⓪(bra info0⓪ noinfo CLR.W saveinfo⓪ info0 clr.b (A2)+⓪(clr.b (A2)+⓪(clr.b (A2)+⓪(clr.b (A2)+⓪(move #1,saved⓪(move.l ptrStart,d1⓪(tst errorNr⓪(beq nomark⓪(clr errorNr⓪(move.l errorpos,d0⓪(beq nomark⓪(add.l d1,d0⓪(lea tags,A1⓪(move.l d0,$3C(A1) ; tags['?'] setzen⓪ nomark lea tabs,a0⓪(cmpi.b #80,(a0)⓪(bne noload⓪(moveq #39,d0⓪ cptab move (a0)+,(a3)+⓪(dbf d0,cptab⓪(clr.w (a3)+⓪(jsr GetTabs⓪ noload jsr CountTabs⓪(tst leaveDLEonWrite⓪(bne noclean ; Text wurde mit DLEs gespeichert⓪(jsr Cleantext⓪ noclean⓪ END⓪ END ReadText;⓪ ⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE Page(dir: BOOLEAN); (* 20*Repeatfactor Zeilen vor/zurⁿck *)⓪ BEGIN⓪ ClrKBDbuffer;⓪ ASSEMBLER⓪(move.l ptr,a0⓪(move.l a0,scrPtr⓪(jsr RptfOK ; liefert rptf in D0⓪(move.l d0,d5⓪(; umrechnen in Zeilenanzahl⓪(move.w NoOfTextLines,d0⓪(sub.w #4,d0⓪(mulu d0,d5⓪(lea NextCR,A1⓪(tst -(a3)⓪(beq pbild⓪(lea LastCR,A1⓪ pbild jsr (A1)⓪(bne nokor1 ; end of text⓪(subq.l #1,d5⓪(bgt pbild⓪ nokor1 jsr LineSt⓪(clr.l rptf⓪(move.l a0,ptr⓪(move.l #ScreenOut,(a3)+⓪(jmp CondScreen⓪ END⓪ END Page;⓪"⓪ (*$l-*)⓪ PROCEDURE Down; (* eine Zeile runter *)⓪ BEGIN⓪ ASSEMBLER⓪*clr forceTab⓪*move.l ptr,a0⓪ cr1 move.b (a0)+,d0⓪*beq Downrt⓪*cmpi.b #CRchar,d0⓪*bne cr1⓪*move.b ptrX,hilf⓪*jsr WriteLn⓪*move ptrLine,d0⓪*addq #1,d0⓪*move d0,ptrLine⓪*cmp maxLine,d0⓪*ble crzanflf⓪*move maxLine,ptrLine⓪*move.l a0,-(a7)⓪*clr cmdFlag⓪*jsr LineOut⓪*move.l (a7)+,a0⓪ crzanflf move ptrY,d1⓪*move.b ptrX,d1⓪*moveq #0,d0⓪*move.b ch,d0⓪*clr.b d1⓪*tst delFlag⓪*bne crzanf1⓪*cmpi #downKey,d0⓪*bne crzanf1⓪*move.b hilf,d1⓪ crzanf1 jmp FindCursor⓪ Downrt move #1,forceTab⓪ END⓪ END Down;⓪ ⓪ (*$l-*)⓪ PROCEDURE UpNoCursor; (* eine Zeile rauf *)⓪ BEGIN⓪ ASSEMBLER⓪(clr forceTab⓪(move.l ptr,a0⓪(jsr LineSt⓪(tst.b -1(a0)⓪(beq uprt⓪(jsr LastCR⓪(jsr LineSt⓪(cmpi #1,ptrLine⓪(bhi up1⓪(clr cmdflag⓪(moveq #HomeChar,d0⓪(jsr ChrOut⓪(moveq #ClrLnChar,D0⓪(jsr ChrOut⓪(moveq #UpChar,D0⓪(jsr ChrOut⓪(moveq #DownChar,D0⓪(jsr ChrOut⓪(movem.l d0/a0,-(a7)⓪(jsr LineOut⓪(movem.l (a7)+,d0/a0⓪(rts⓪ up1 subq.b #1,ptrY⓪(subq #1,ptrLine⓪(rts⓪ uprt move #1,forceTab⓪ END⓪ END UpNoCursor;⓪ ⓪ (*$l-*)⓪ PROCEDURE Up; (* eine Zeile rauf *)⓪ BEGIN⓪ ASSEMBLER⓪(clr forceTab⓪(move.l ptr,a0⓪(jsr LineSt⓪(tst.b -1(a0)⓪(beq.l uprt⓪(jsr LastCR⓪(jsr LineSt⓪(cmpi #1,ptrLine⓪(bhi up1⓪(move ptrX,-(a7)⓪(clr cmdflag⓪(moveq #HomeChar,d0⓪(jsr ChrOut⓪(moveq #ClrLnChar,D0⓪(jsr ChrOut⓪(moveq #UpChar,D0⓪(jsr ChrOut⓪(moveq #DownChar,D0⓪(jsr ChrOut⓪(movem.l d0/a0,-(a7)⓪(jsr LineOut⓪(movem.l (a7)+,d0/a0⓪(move (a7)+,ptrX⓪(bra up2⓪ up1 subq.b #1,ptrY⓪(subq #1,ptrLine⓪ up2 move ptrY,d1⓪(clr.b d1⓪(cmpi.b #CRchar,ch⓪(beq upzanf⓪(move.b ptrX,d1⓪ upzanf jmp FindCursor⓪ uprt move #1,forceTab⓪ END⓪ END Up;⓪ ⓪ (*$l-*)⓪ PROCEDURE ScrollUp;⓪"BEGIN⓪$ASSEMBLER⓪*clr forceTab⓪*move.l ptr,a0⓪ cr1 move.b (a0)+,d0⓪*beq.w Downrt⓪*cmpi.b #CRchar,d0⓪*bne cr1⓪*⓪*; prüfen, ob noch /ptrLine/ Zeilen darunter sind⓪*move.l a0,temp⓪*move maxline,d1⓪*sub ptrline,d1⓪*cmp d1,d1⓪*bra con1⓪ lup1 jsr nextcr⓪ con1 dbne d1,lup1⓪*bne.w downrt⓪*⓪*; jsr lastcr⓪*; jsr LineSt⓪*move ptrY,d1⓪*move.b ptrX,d1⓪*move d1,-(a7)⓪*move ptrLine,-(a7)⓪*move maxLine,ptrLine⓪*move maxLine,D1⓪*lsl #8,d1⓪*jsr gotoxyd1 ; auf letzte Zeile springen⓪*jsr writeln⓪*clr cmdFlag⓪*jsr LineOut⓪*move.l temp,a0⓪*move (a7)+,ptrLine⓪*move (a7)+,d1⓪*jmp FindCursor⓪ Downrt move #1,forceTab⓪$END⓪"END ScrollUp;⓪ ⓪ (*$l-*)⓪ PROCEDURE ScrollDown;⓪"BEGIN⓪$ASSEMBLER⓪(clr forceTab⓪(move.l ptr,a0⓪(jsr LineSt⓪(tst.b -1(a0)⓪(beq.l uprt⓪(jsr LastCR⓪(jsr LineSt⓪ ⓪(; prüfen, ob noch /ptrLine/ Zeilen darüber sind⓪(move.l a0,temp⓪(move ptrline,d1⓪(subq #1,d1⓪(cmp d1,d1⓪(bra con1⓪ lup1 jsr lastcr⓪ con1 dbne d1,lup1⓪(bne.w uprt⓪ ⓪(jsr LineSt⓪(move ptrY,d1⓪(move.b ptrX,d1⓪(move d1,-(a7)⓪(moveq #HomeChar,d0⓪(jsr ChrOut⓪(moveq #ClrLnChar,D0⓪(jsr ChrOut⓪(moveq #UpChar,D0⓪(jsr ChrOut⓪(move #$0100,D1⓪(jsr gotoxyd1⓪(move ptrLine,-(a7)⓪(move #1,ptrLine⓪(clr cmdFlag⓪(jsr LineOut⓪(move.l temp,a0⓪(move (a7)+,ptrLine⓪(move (a7)+,d1⓪(jmp FindCursor⓪ uprt move #1,forceTab⓪$END⓪"END ScrollDown;⓪ ⓪ (*$l-*)⓪ PROCEDURE Right; (* ein Zeichen nach rechts *)⓪ BEGIN⓪ ASSEMBLER⓪(clr forceTab⓪(move.l ptr,a0⓪ again move.b (a0)+,d0⓪(beq force⓪(cmpi.b #CRchar,d0⓪(beq rcr⓪(cmpi.b #$20,d0⓪(bcs again⓪(move.l a0,ptr⓪(move ptrY,d1⓪(move.b ptrX,d1⓪(cmp.b maxCol,d1⓪(beq force⓪(addq.b #1,d1⓪(jmp GotoXYd1⓪ rcr jmp Down⓪ force move #1,forceTab⓪ END⓪ END Right;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE GotoEOLN;⓪ BEGIN⓪ ASSEMBLER⓪ goright move.l ptr,a0⓪(move.b (a0),d0⓪(beq xit⓪(cmpi.b #CRchar,d0⓪(beq xit⓪(jsr Right⓪(bra goright⓪ xit⓪ END⓪ END GotoEOLN;⓪ ⓪ (*$l-*)⓪ PROCEDURE WordRight; (* ein Wort nach rechts *)⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(move.b (a0),d0⓪(jsr alphanum⓪(bne lp2⓪ lp1 jsr Right⓪(tst forceTab⓪(bne wrout⓪(move.l ptr,a0⓪(move.b (a0),d0⓪(jsr AlphaNum⓪(beq lp1⓪ lp2 jsr Right⓪(tst forceTab⓪(bne wrout⓪(move.l ptr,a0⓪(move.b (a0),d0⓪(jsr AlphaNum⓪(bne lp2⓪ wrout⓪ END⓪ END WordRight;⓪ ⓪ (*$l-*)⓪ PROCEDURE Left; (* ein Zeichen nach links *)⓪ BEGIN⓪ ASSEMBLER⓪(clr forceTab⓪(move.l ptr,a0⓪ again move.b -(a0),d0⓪(beq leftrt⓪(cmpi.b #CRchar,d0⓪(beq crback⓪(cmpi.b #DLEchar,-1(a0)⓪(bne delit⓪(tst.b -2(a0)⓪(beq leftrt⓪(bra crback⓪ delit cmpi.b #$20,d0⓪(bcs again⓪(jsr LineSt⓪(move ptrY,d1⓪(move.b ptrX,d1⓪(subq.b #1,d1⓪(jmp FindCursor⓪(move.l a0,ptr⓪(moveq #LeftChar,d0⓪(jmp ChrOut⓪ crback jsr UpNoCursor⓪(jsr LineSt⓪(move ptrY,d1⓪(move.b maxCol,d1⓪(jmp FindCursor⓪ leftrt move #1,forceTab⓪ END⓪ END Left;⓪ ⓪ (*$l-*)⓪ PROCEDURE OnSOLn (): BOOLEAN;⓪ BEGIN⓪ ASSEMBLER⓪(moveq #1,d0⓪(move.l ptr,a0⓪(cmpi.b #CRchar,-1(a0)⓪(beq xit⓪(cmpi.b #dlechar,-2(a0)⓪(beq xit⓪(clr d0⓪ xit move d0,(a3)+⓪ END⓪ END OnSOLn;⓪ ⓪ (*$l-*)⓪ PROCEDURE GotoSOLN;⓪ BEGIN⓪ ASSEMBLER⓪ goleft move.l ptr,a0⓪(move.b -1(a0),d0⓪(beq xit⓪(cmpi.b #CRchar,d0⓪(beq xit⓪(move.b -2(a0),d0⓪(beq xit⓪(cmpi.b #DLEchar,d0⓪(beq xit⓪(jsr Left⓪(bra goleft⓪ xit⓪ END⓪ END GotoSOLN;⓪ ⓪ (*$l-*)⓪ PROCEDURE WordLeft; (* ein Wort nach links *)⓪ BEGIN⓪ ASSEMBLER⓪ lp1 jsr Left⓪(tst forceTab⓪(bne wrout⓪(move.l ptr,a0⓪(move.b (a0),d0⓪(jsr AlphaNum⓪(bne lp1⓪ lp2 move.l ptr,a0⓪(move.b -1(a0),d0⓪(beq wrout⓪(cmpi.b #DLEchar,-2(a0)⓪(beq wrout⓪(jsr alphanum⓪(bne wrout⓪(jsr Left⓪(tst forceTab⓪(beq lp2⓪ wrout⓪ END⓪ END WordLeft;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelRight; (* nach rechts l÷schen *)⓪ BEGIN⓪ ASSEMBLER⓪(clr forceTab⓪(move.l ptr,a0⓪ again move.b (a0)+,d0⓪(beq force⓪(cmpi.b #CRchar,d0⓪(beq rcr⓪(cmpi.b #$20,d0⓪(bcs again⓪(move.l a0,ptr⓪(move.b ptrX,d1⓪(cmp.b maxCol,d1⓪(beq force⓪(moveq #' ',d0⓪(cmpa.l delPtr,a0⓪(bhi delaus⓪(move.b -1(a0),d0⓪ delaus jmp ChrOut⓪ rcr jmp Down⓪ force move #1,forceTab⓪ END⓪ END DelRight;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelLeft; (* nach links l÷schen *)⓪ BEGIN⓪ ASSEMBLER⓪(clr forceTab⓪(move.l ptr,a0⓪ again move.b -(a0),d0⓪(beq leftrt⓪(cmpi.b #CRchar,d0⓪(beq crback⓪(cmpi.b #DLEchar,-1(a0)⓪(bne delit⓪(tst.b -2(a0)⓪(beq leftrt⓪(bra crback⓪ delit cmpi.b #$20,d0⓪(bcs again⓪(move.l a0,ptr⓪(moveq #LeftChar,d0⓪(jsr ChrOut⓪(move.b (a0),d0⓪(cmpa.l delPtr,a0⓪(bcc delaus⓪(moveq #' ',d0⓪ delaus jsr ChrOut⓪(moveq #LeftChar,d0⓪(jmp ChrOut⓪ crback jsr UpNoCursor⓪(jsr LineSt⓪(move ptrY,d1⓪(move.b maxCol,d1⓪(jmp FindCursor⓪ leftrt move #1,forceTab⓪ END⓪ END DelLeft;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelLine; (* Zeile löschen mit DelRight/Left *)⓪ BEGIN⓪ ASSEMBLER⓪ delln move.l temp,a0⓪(cmpa.l ptr,a0⓪(bgt delfor⓪(blt delbck⓪(rts⓪ delfor jsr DelRight⓪(bra delln⓪ delbck jsr DelLeft⓪(bra delln⓪ END⓪ END DelLine;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelWordRight; (* Wort rechts l÷schen *)⓪ BEGIN⓪ ASSEMBLER⓪(bra lp0⓪ again move.b (a0)+,d0⓪(beq wrout⓪(cmpi.b #CRchar,d0⓪(bne nocr⓪(cmpi.b #DLEchar,(a0)⓪(bne ok⓪(addq.l #2,a0⓪(bra ok⓪ nocr cmpi.b #$20,d0⓪(bcs again⓪ ok rts⓪ lp0 move.l ptr,a0⓪(move.b (a0),d0⓪(beq wrout⓪(jsr alphanum⓪(bne lp2⓪ lp1 bsr again⓪(move.b (a0),d0⓪(beq wrout⓪(jsr AlphaNum⓪(beq lp1⓪ lp2 bsr again⓪(move.b (a0),d0⓪(beq wrout⓪(jsr AlphaNum⓪(bne lp2⓪(move.l a0,temp⓪(jsr DelLine⓪ wrout⓪ END⓪ END DelWordRight;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelWordLeft; (* Wort links l÷schen *)⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(bra lp1⓪ again move.b -(a0),d0⓪(beq dwlout⓪(cmpi.b #CRchar,d0⓪(beq leftok⓪(cmpi.b #DLEchar,-1(a0)⓪(bne delit⓪(subq.l #1,a0⓪(bra again⓪ delit cmpi.b #$20,d0⓪(bcs again⓪ leftok rts⓪ lp1 bsr again⓪(tst.b d0⓪(beq dwlout⓪(jsr AlphaNum⓪(bne lp1⓪ lp2 move.b -1(a0),d0⓪(beq dwlok⓪(cmpi.b #DLEchar,-2(a0)⓪(beq dwlok⓪(jsr alphanum⓪(bne dwlok⓪(bsr again⓪(tst.b d0⓪(beq dwlout⓪(tst forceTab⓪(beq lp2⓪ dwlok move.l a0,temp⓪(jsr DelLine⓪ dwlout⓪ END⓪ END DelWordLeft;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelToEOLN; (* bis Zeilenende l÷schen *)⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(jsr NextCR⓪(bne nodel⓪(subq.l #1,a0⓪(move.l a0,temp⓪(jmp DelLine⓪ nodel⓪ END⓪ END DelToEOLN;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelToSOLN; (* bis Zeilenanfang l÷schen *)⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(jsr LastCR⓪(bne noadd⓪(addq.l #1,a0⓪ noadd cmpi.b #DLEchar,(a0)⓪(bne ok⓪(addq.l #2,a0⓪ ok move.l a0,temp⓪(jmp DelLine⓪ END⓪ END DelToSOLN;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelDown; (* nach unten löschen *)⓪ BEGIN⓪ ASSEMBLER⓪*move.l ptr,a0⓪ cr1 move.b (a0)+,d0⓪*bne cr11⓪*rts⓪ cr11 cmpi.b #CRchar,d0⓪*bne cr1⓪*moveq #0,d0⓪*move.b ch,d0⓪*move.b ptrX,d1⓪*cmpi #downKey,d0⓪*beq crmitte⓪*moveq #0,d1⓪ crmitte moveq #0,d3⓪*cmpi.b #DLEchar,(a0)⓪*bne xit⓪*addq.l #1,a0⓪*move.b (a0)+,d3⓪*sub.b #DLEoffset,d3⓪*cmp.b d3,d1⓪*ble xit⓪ fc1 move.b (a0),d4⓪*beq xit⓪*cmpi.b #CRchar,d4⓪*beq xit⓪*addq.l #1,a0⓪*addq.b #1,d3⓪*cmp.b d3,d1⓪*bne fc1⓪ xit move.l a0,temp⓪*jmp DelLine⓪ END⓪ END DelDown;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelUp; (* nach oben löschen *)⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(jsr LineSt⓪(jsr LastCR⓪(bne uprt⓪(jsr LineSt⓪(move.b ptrX,d1⓪(cmpi.b #EnterKey,ch⓪(bne crmitt⓪(moveq #0,d1⓪ crmitt moveq #0,d3⓪(cmpi.b #DLEchar,(a0)⓪(bne xit⓪(addq.l #1,a0⓪(move.b (a0)+,d3⓪(sub.b #DLEoffset,d3⓪(cmp.b d3,d1⓪(ble xit⓪ fc1 move.b (a0),d4⓪(beq xit⓪(cmpi.b #CRchar,d4⓪(beq xit⓪(addq.l #1,a0⓪(addq.b #1,d3⓪(cmp.b d3,d1⓪(bne fc1⓪ xit move.l a0,temp⓪(jmp DelLine⓪ uprt⓪ END⓪ END DelUp;⓪ ⓪ (*$l-*)⓪ PROCEDURE InsWrite; (* Bildschrim ab Cursor neu aufbauen *)⓪ BEGIN⓪ ASSEMBLER⓪(move d1,-(a7)⓪(jsr GotoXYd1⓪(clr d0⓪(move.b ptrY,d0⓪(move d0,ptrLine⓪(move.l ptr,a0⓪ inslnw jsr LineOut⓪(moveq #0,d0⓪(move.b ptrY,d0⓪(cmp maxLine,d0⓪(bcc inslnx⓪(jsr WriteLn⓪(bra inslnw⓪ inslnx move (a7)+,d1⓪(jmp GotoXYd1⓪ END⓪ END InsWrite;⓪ ⓪ (*$l-*)⓪ PROCEDURE InsRight; (* ein Zeichen nach rechts im Insert-Buf. (bufferM) *)⓪ END InsRight;⓪ ⓪ (*$l-*)⓪ PROCEDURE InsBackSpace; (* ein Zeichen aus Insert-Buffer l÷schen (bufferM) *)⓪ BEGIN⓪ ASSEMBLER⓪+clr forceTab⓪+move.l bufferL,a0⓪+cmpa.l bufferH,a0⓪+bcs eleft1⓪+move.l ptr,a0⓪+cmpi.b #DLEchar,-2(a0)⓪+bne ilefterr⓪+move.b -(a0),d0⓪+cmpi.b #DLEoffset,d0⓪+bls ilefterr⓪+subq.b #1,d0⓪+move.b d0,(a0)⓪+move.b d0,dleWert⓪+bra.l insback⓪ ilefterr move #1,forceTab⓪+rts⓪ eleft1 cmpi.b #CRchar,(a0)⓪+beq crleft⓪+cmpi.b #DLEchar,1(a0)⓪+beq dleleft⓪+move.b (a0),d0⓪+addq.l #1,bufferL⓪+addq.l #1,bufferM⓪+cmpi.b #$20,d0⓪+bcs insbctrl⓪+bra insback⓪ dleleft move.b (a0),d0⓪+cmpi.b #DLEoffset,d0⓪+bhi dleleft1⓪+addq.l #2,a0⓪ crleft addq.l #1,a0⓪+move.l a0,bufferL⓪+move.l a0,bufferM⓪+move ptrY,d1⓪+clr.b d1⓪+subi #256,d1⓪+ble ilefterr⓪ findx cmpi.b #CRchar,(a0)⓪+beq foundx⓪+addq.l #1,a0⓪+addq.b #1,d1⓪+cmpa.l bufferH,a0⓪+bls findx⓪+move.l bufferH,a0⓪+subq.b #1,d1⓪+add.b ptrXIns,d1⓪ foundx cmpi.b #DLEchar,-(a0)⓪+bne foundx1⓪+subq.b #2,d1⓪+add.b -(a0),d1⓪+sub.b #DLEoffset,d1⓪ foundx1 jmp InsWrite⓪ dleleft1 subq.b #1,d0⓪+move.b d0,dleWert⓪+move.b d0,(a0)⓪ insback moveq #BSchar,d0⓪+jsr ChrOut⓪ insbctrl move ptrY,d1⓪+move.b ptrX,d1⓪+move d1,-(a7)⓪+move.l ptr,a0⓪+jsr LineOut⓪+move (a7)+,d1⓪+jmp GotoXYd1⓪ END⓪ END InsBackSpace;⓪ ⓪ (*$l-*)⓪ PROCEDURE InsLeft; (* ein Zeichen nach links im Insert-Buf. (bufferM) *)⓪ BEGIN⓪ ASSEMBLER jmp InsBackSpace⓪ END⓪ END InsLeft;⓪ ⓪ (*$l-*)⓪ PROCEDURE InsDelete; (* Zeichen unter Cursor l÷schen (bufferM) *)⓪ BEGIN⓪ ASSEMBLER jmp InsBackSpace⓪ END⓪ END InsDelete;⓪ ⓪ (*$l-*)⓪ PROCEDURE InsLine; (* eine Zeile einfⁿgen *)⓪ BEGIN⓪ ASSEMBLER⓪(move #3,(a3)+⓪(jsr Available⓪(tst -(a3)⓪(bne ins1⓪(jsr Overflow⓪(jmp InsCmd⓪ ins1 jsr ClrLn⓪(moveq #ClrEOLNchar,d0⓪(jsr ChrOut⓪(move.l bufferL,a0⓪(move.b #CRchar,-(a0)⓪(move.b dleWert,d5⓪(move.b d5,d4⓪(subi.b #DLEoffset,d4⓪(move.b d4,d6⓪(tst makeDLE⓪(beq inodle⓪(move.b #DLEchar,-(a0)⓪(move.b d5,-(a0)⓪(bra ins2⓪ inodle subq.b #1,d4⓪(bmi ins2⓪(move.b #' ',-(a0)⓪(bra inodle⓪ ins2 move.l a0,bufferL⓪(move.l a0,bufferM⓪(move ptrY,d1⓪(move.b d6,d1⓪(jmp InsWrite⓪ END⓪ END InsLine;⓪ ⓪ (*$l-*)⓪ PROCEDURE IntoBuffer(ch: CHAR); (* ch im Insert-Buffer ablegen *)⓪ BEGIN⓪ ASSEMBLER⓪(subq.l #1,a3⓪(moveq #0,d0⓪(move.b -(a3),d0⓪(move #1,(a3)+⓪(jsr Available⓪(tst -(a3)⓪(bne ins1⓪(jsr Overflow⓪(jmp InsCmd⓪ ins1 move #1,forceTab⓪(move.b ptrX,d1⓪(cmp.b maxCol,d1⓪(bcc ins2⓪ ins11 jsr ChrOut⓪(clr forceTab⓪ ins2 move.l bufferL,a0⓪(cmpi.b #' ',d0⓪(bne bufch⓪(cmpi.b #DLEchar,1(a0)⓪(beq bufdle⓪(cmpa.l bufferH,a0⓪(bcs bufch⓪(move.l ptr,A1⓪(cmpi.b #DLEchar,-2(A1)⓪(bne bufch⓪(lea -1(A1),a0⓪ bufdle addq.b #1,dleWert⓪(bpl bufdl1⓪(subq.b #1,dleWert⓪ bufdl1 addq.b #1,(a0)⓪(bpl bufwrt⓪(subq.b #1,(a0)⓪(bra bufwrt⓪ bufch move.b d0,-(a0)⓪(move.l a0,bufferL⓪(move.l a0,bufferM⓪ bufwrt move ptrY,d1⓪(move.b ptrX,d1⓪(move d1,-(a7)⓪(move.l ptr,a0⓪(jsr LineOut⓪(move (a7)+,d1⓪(jmp GotoXYd1⓪ END⓪ END IntoBuffer;⓪ ⓪ (*$l-*)⓪ PROCEDURE Break;⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(cmpi.b #DLEchar,-2(a0)⓪(beq fndna⓪(move.b -1(a0),d0⓪(jsr AlphaNum⓪(bne spcvor⓪ fndna move.b (a0)+,d0 ;suche non-alpha-char.⓪(beq.l exbrk⓪(jsr AlphaNum⓪(beq fndna⓪(subq.l #1,a0⓪ spcvor cmpi.b #' ',(a0)+⓪(beq spcvor⓪(subq.l #1,a0⓪(move.l a0,ptr⓪(jsr LineSt ;a0 zeigt auf voriges CR⓪(moveq #DLEoffset,d0⓪(moveq #1,d1⓪(tst makeDLE⓪(beq nodle⓪(cmpi.b #DLEchar,(a0)⓪(bne nodle⓪(addq.l #2,d1⓪(move.b 1(a0),d0⓪ nodle move d1,d2⓪(move.b d0,dleWert⓪(move.l ptr,a0⓪(move.l a0,(a3)+⓪ spcweg move.b -(a0),d0⓪(cmpi.b #DLEchar,d0⓪(beq fnddle⓪(cmpi.b #' ',d0⓪(bne nospc⓪(subq.l #1,d1⓪(bra spcweg⓪ fnddle addq.l #1,d1⓪ nospc move.l d1,(a3)+⓪(add.l d1,ptr⓪(move d2,-(a7)⓪(jsr MoveText⓪(move (a7)+,d2⓪(move.l ptr,a0⓪(suba d2,a0⓪(move.b #CRchar,(a0)+⓪(tst makeDLE⓪(beq exbrk⓪(move.b #DLEchar,(a0)+⓪(move.b dleWert,(a0)+⓪ exbrk jsr ScreenOut⓪ END⓪ END Break;⓪ ⓪ (*$l-*)⓪ PROCEDURE Glue;⓪ BEGIN⓪ ASSEMBLER⓪(jsr RptfOK⓪ gluelp move.l ptr,a0⓪(moveq #-1,d1⓪ fndcr move.b (a0)+,d0⓪(beq exglue⓪(cmpi.b #CRchar,d0⓪(bne fndcr⓪(cmpi.b #DLEchar,-3(a0)⓪(beq spcda⓪(cmpi.b #' ',-2(a0)⓪(beq spcda⓪(move.b #' ',-1(a0)⓪(addq.l #1,d1⓪ spcda cmpi.b #DLEchar,(a0)⓪(bne movok⓪(addq.l #2,a0⓪(subq.l #2,d1⓪ movok move.l a0,(a3)+⓪(move.l d1,(a3)+⓪(adda.l d1,a0⓪(move.l a0,ptr⓪(jsr MoveText⓪(subq.l #1,rptf⓪(;bne gluelp ;Glue ohne Rptf!!⓪ exglue jsr ScreenOut⓪(clr.l rptf⓪ END⓪ END Glue;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelOneChar;⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(move.b (a0),d0⓪(beq xit⓪(cmpi.b #CRchar,d0⓪(beq xit⓪(addq.l #1,a0⓪(move.l a0,(a3)+⓪(move.l #-1,(a3)+⓪(jsr MoveText⓪(jsr PushPtr⓪(move ptrY,d1⓪(move.b ptrX,d1⓪(move.l ptr,a0⓪(move #1,insflag⓪(jsr LineOut⓪(clr insflag⓪(jsr GotoXYd1⓪ xit⓪ END⓪ END DelOneChar;⓪ ⓪ (*$l-*)⓪ PROCEDURE DelOneCharLeft;⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(tst.b -(a0)⓪(beq xit⓪(move.b -1(a0),d0⓪(beq xit⓪(cmpi.b #DLEchar,d0⓪(bne nodle⓪(move.b (a0),d0⓪(subq.b #1,d0⓪(cmpi.b #DLEoffset,d0⓪(bge store0⓪(moveq #DLEoffset,d0⓪ store0 move.b d0,(a0)+⓪(move.l a0,ptr⓪(subq.l #2,a0⓪(move ptrY,d1⓪(clr.b d1⓪(jsr GotoXYd1⓪(jsr LineOut⓪(jmp GotoPtr⓪ nodle jsr Left⓪(jmp DelOneChar⓪ xit⓪ END⓪ END DelOneCharLeft;⓪ ⓪ (*$l-*)⓪ PROCEDURE InsOneChar;⓪ BEGIN⓪ ASSEMBLER⓪&(*move.l ptr,a0⓪(move.b -(a0),d0⓪(beq nodle⓪(cmpi.b #DLEchar,-1(a0)⓪(bne nodle⓪(addq.b #1,d0⓪(bmi xit⓪(move.b d0,(a0)⓪(subq.l #1,a0⓪(move ptrY,d1⓪(clr.b d1⓪(jsr GotoXYd1⓪(jsr LineOut⓪(jmp GotoPtr⓪ nodle*) move #1,(a3)+⓪(jsr Available⓪(tst -(a3)⓪(beq xit⓪(move.l ptr,(a3)+⓪(move.l #1,(a3)+⓪(jsr MoveText⓪(jsr PushPtr⓪(move ptrY,d1⓪(move.b ptrX,d1⓪(move #1,insflag⓪(move.l ptr,a0⓪(move.b #' ',(a0)⓪(jsr LineOut⓪(clr insflag⓪(jsr GotoXYd1⓪ xit⓪ END⓪ END InsOneChar;⓪ ⓪ (*$l+*)⓪ PROCEDURE InsMode; (* Insert-Modus *)⓪"VAR ptrLTemp:CARDINAL;⓪ BEGIN⓪"InsCmd;⓪"ASSEMBLER⓪,move.b ptrX,ptrXIns⓪,move ptrLine,ptrLTemp(A6)⓪,move #1,insFlag⓪,move.l bufferH,a0⓪,move.l a0,bufferL⓪,move.l a0,bufferM⓪,move.l ptr,a0⓪,move.b -1(a0),temp⓪,jsr LineSt⓪,moveq #DLEoffset,d0⓪,cmpi.b #DLEchar,(a0)+⓪,bne ikeindle⓪,move.b (a0),d0⓪"ikeindle move.b d0,dleWert⓪"END;⓪"REPEAT⓪$ReadCh;⓪$IF ch=EnterKey THEN⓪&InsLine;⓪&IF ptrLine=maxLine THEN InsCmd END⓪$ELSIF ch=leftKey THEN InsLeft⓪$ELSIF ch=BSkey THEN InsBackSpace⓪$ELSIF ch=DELkey THEN InsDelete⓪$ELSIF ch=TabLeftKey THEN REPEAT InsLeft UNTIL TabSet()⓪$ELSIF ch=rightKey THEN⓪&IF bufferM=bufferL THEN IntoBuffer(' ') ELSE InsRight END⓪$ELSIF ch=TabRightKey THEN⓪&REPEAT⓪(IF bufferM=bufferL THEN IntoBuffer(' ') ELSE InsRight END⓪&UNTIL TabSet()⓪$ELSIF ch IN allowed THEN IntoBuffer(ch)⓪$ELSIF accept THEN BufferToText(false) END⓪"UNTIL abort OR accept;⓪"PushPtr;⓪"lastPtr:=ptr;⓪"insFlag:=false;⓪"IF abort THEN⓪$ASSEMBLER move.l ptr,a0 move.b temp,-1(a0) move ptrLTemp(A6),ptrLine END;⓪$ScreenOut⓪"END⓪ END InsMode;⓪ ⓪ (*$l+*)⓪ PROCEDURE DelMode; (* Delete-Modus *)⓪"VAR ptrLTemp:CARDINAL;⓪ BEGIN⓪"ASSEMBLER move.l ptr,delPtr move ptrLine,ptrLTemp(A6) clr cmdFlag⓪*move #1,delFlag clr.l rptf⓪"END;⓪"LOOP⓪$IF CmdLineAway(FALSE) THEN⓪&PutCmdOrTab('Delete: /F1/ or /Enter/ deletes, /ESC/ ignores');⓪&cmdFlag:=true⓪$END;⓪$ReadUpCh;⓪$IF accept THEN AbInBuffer; EXIT⓪$ELSIF abort THEN DelInBuffer; EXIT⓪$ELSIF DirKey() OR Rptfx10() THEN⓪$ELSE RptfOk;⓪&REPEAT⓪(IF (ch=leftKey) OR (ch=BSkey) OR (ch=DELkey) THEN DelLeft⓪(ELSIF (ch=rightKey) OR (ch=' ') THEN DelRight⓪(ELSIF ch=TabLeftKey THEN REPEAT DelLeft UNTIL (ptr<=ptrStart) OR TabSet()⓪(ELSIF ch=TabRightKey THEN REPEAT DelRight UNTIL (ptr>=ptrEnd-2L) OR TabSet()⓪(ELSIF ch=EnterKey THEN IF direction THEN DelUp ELSE DelDown END;⓪(ELSIF ch=EOLNkey THEN DelToEOLN⓪(ELSIF ch=SOLNkey THEN DelToSOLN⓪(ELSIF ch=WordLeftKey THEN DelWordLeft⓪(ELSIF ch=WordRightKey THEN DelWordRight⓪(ELSIF ch=upKey THEN DelUp⓪(ELSIF ch=downKey THEN DelDown⓪(END;⓪(DEC(rptf)⓪&UNTIL (rptf=0L) OR KeyPressed()⓪$END⓪"END;⓪"cmdFlag:=false; delFlag:=false;⓪"IF (ptr>delPtr) OR abort THEN ptr:=delPtr END;⓪"PushPtr;⓪"lastPtr:=ptr;⓪"ptrLine:=ptrLTemp;⓪"ScreenOut⓪ END DelMode;⓪ ⓪ (*$l-*)⓪ PROCEDURE Zap; (* Zap zum l÷schen gr÷sserer Stⁿcke *)⓪ BEGIN⓪"temp:=ptr;⓪"ChkLastPtr;⓪"CASE ChkZap() OF⓪"0:AbInBuffer; ScreenOut |⓪"1:PutCmd('Zap more than 200 characters? ');⓪$IF Yes() THEN AbInBuffer; ScreenOut ELSE ptr:=temp END |⓪"2:PutCmd('Zap: no room to buffer - delete anyway? ');⓪$IF Yes() THEN⓪&bufferL:=bufferH;⓪&MoveText(delPtr,LONGINT(ptr)-LONGINT(delPtr));⓪&ScreenOut⓪$ELSE ptr:=temp⓪$END⓪"END⓪ END Zap;⓪ ⓪ (* ED5.ICL *)⓪ ⓪ (*$l-*)⓪ PROCEDURE Exchange;⓪ BEGIN⓪"cmdFlag:=false;⓪"LOOP⓪$IF CmdLineAway(FALSE) THEN⓪&PutCmdOrTab('Exchange: /ESC/, /F1/ or /Enter/ to END');⓪&cmdFlag:=true⓪$END;⓪$ReadCh;⓪$IF accept OR abort THEN EXIT⓪$ELSIF ch=EOLNkey THEN GotoEOLN⓪$ELSIF ch=SOLNkey THEN GotoSOLN⓪$ELSIF ch=leftKey THEN Left⓪$ELSIF ch=rightKey THEN Right⓪$ELSIF ch=wordLeftKey THEN WordLeft⓪$ELSIF ch=wordRightKey THEN WordRight⓪$ELSIF ch=TabLeftKey THEN REPEAT Left UNTIL TabSet()⓪$ELSIF ch=TabRightKey THEN REPEAT Right UNTIL TabSet()⓪$ELSIF ch=EnterKey THEN Down⓪$ELSIF (ch=PageDownKey) OR (ch=PageUpKey) THEN Page(ch=PageUpKey)⓪$ELSIF ch=upKey THEN Up⓪$ELSIF ch=downKey THEN Down⓪$ELSIF ch=scrlUpKey THEN ScrollUp;⓪$ELSIF ch=scrlDownKey THEN ScrollDown;⓪$ELSIF ch=DELkey THEN DelOneChar⓪$ELSIF ch=INSkey THEN InsOneChar⓪$ELSIF ch=BSkey THEN DelOneCharLeft⓪$ELSIF (ch IN allowed) & Exchg(ch) THEN ASSEMBLER⓪&move.b ptrX,d0 cmp.b maxCol,d0 bhi no move.b ch,d0 jsr ChrOut no END⓪$END⓪"END;⓪"PushPtr;⓪"cmdFlag:=false⓪ END Exchange;⓪ ⓪ (*$l+*)⓪ PROCEDURE Adjust; (* zum Einrⁿcken von Zeilen und Bl÷cken *)⓪"VAR dlediff:CARDINAL;⓪ BEGIN⓪"ASSEMBLER clr dlediff(A6) clr cmdFlag clr.l rptf END;⓪"LOOP⓪$IF CmdLineAway(FALSE) THEN⓪&PutCmdOrTab('Adjust: <-, ->, L(eft, /CR/, /ESC/');⓪&cmdFlag:=true⓪$END;⓪$ReadUpCh;⓪$IF abort OR accept THEN EXIT⓪$ELSIF DirKey() OR Rptfx10() THEN⓪$ELSE RptfOK;⓪&ASSEMBLER⓪&adjloop move.l ptr,a0 ;Hauptschleife⓪1jsr LineSt ;a0 zeigt auf evtl. DLE⓪1moveq #0,d0⓪1move.b ch,d0⓪1cmpi #upKey,d0⓪1beq.l adjup⓪1cmpi.b #EnterKey,d0⓪1bne adj0⓪1tst.w direction⓪1bne.w adjUp⓪1bra.w adjDown⓪&adj0 cmpi #downKey,d0⓪1beq.l adjDown⓪1cmpi.b #DLEchar,(a0)+ ;kein DLE => gleich wieder raus⓪1bne.l adjmor1⓪1move.b (a0),d1 ;Space-Count nach DLE⓪1cmpi #leftKey,d0⓪1bne adj1⓪1cmpi.b #DLEoffset,d1⓪1beq.l adjmor1⓪1subq.b #1,d1⓪1subq.b #1,dlediff(A6)⓪1move.b d1,(a0) ;eins nach links⓪1bra.l adjzeile⓪&adj1 cmpi.b #' ',d0⓪1beq adj11⓪1cmpi #rightKey,d0⓪1bne adj2⓪&adj11 addq.b #1,d1⓪1bpl adjright⓪1subq.b #1,d1⓪&adjright addq.b #1,dlediff(A6)⓪1move.b d1,(a0) ;eins nach rechts⓪1bra.l adjzeile⓪&adj2 cmpi.b #'L',d0 ;L(eft-Adjust⓪1bne adj3⓪1moveq #DLEoffset,d1⓪1sub.b (a0),d1⓪1move.b d1,dlediff(A6) ;Distanz fⁿr weitere Zeilen ber.⓪1move.b #DLEoffset,(a0)⓪1bra.l adjzeile⓪&adj3 cmpi.b #TabRightKey,d0⓪1bne adj4⓪1sub.b #DLEoffset,d1⓪1move.b d1,ptrX⓪&adjtab addq.b #1,dleDiff(A6)⓪1addq.b #1,ptrX⓪1bmi adjzeile⓪1addq.b #1,(a0)⓪1jsr TabSet⓪1tst -(a3)⓪1beq adjtab⓪1bra adjzeile⓪&adj4 cmpi.b #TabLeftKey,d0⓪1bne.l adjmore⓪1sub.b #DLEoffset,d1⓪1move.b d1,ptrX⓪&adjbaktab subq.b #1,dleDiff(A6)⓪1subq.b #1,ptrX⓪1bmi adjzeile⓪1subq.b #1,(a0)⓪1jsr TabSet⓪1tst -(a3)⓪1beq adjbaktab⓪1bra adjzeile⓪&adjDown jsr Down⓪1bra adjupDown⓪&adjup jsr Up⓪&adjupDown move.l ptr,a0⓪1jsr LineSt⓪1cmpi.b #DLEchar,(a0)+⓪1bne adjmor1⓪1move.b (a0),d3⓪1add.b dlediff(A6),d3 ;Zeile erst mal um dlediff verschieben⓪1cmpi.b #DLEoffset,d3⓪1bge adjhl⓪1moveq #DLEoffset,d3⓪&adjhl move.b d3,(a0)⓪&adjzeile clr saved⓪1clr restoreFileDT⓪1move ptrY,d1⓪1clr.b d1⓪1jsr GotoXYd1⓪1addq.l #1,a0⓪1move.l a0,ptr⓪1jsr LineSt⓪1jsr LineOut⓪1jsr GoToPtr⓪&adjmor1 jsr KeyPressed ;bei Repeatfactor evtl. abbrechen⓪1tst -(a3)⓪1bne adjmor2⓪1subq.l #1,rptf⓪1bne.l adjloop⓪&adjmor2 clr.l rptf⓪&adjmore⓪&END⓪$END⓪"END;⓪"cmdFlag:=false⓪ END Adjust;⓪ ⓪ (*$l-*)⓪ PROCEDURE SetTag; (* Tag an aktuelle Text-Position setzen *)⓪ BEGIN⓪"PutCmd('Set tag: enter 0..9 or A..Z: ');⓪"ASSEMBLER⓪*jsr ChrIn⓪*jsr ShiftUp⓪*cmpi #'Z',d0 ;'Z' höchster erlaubter Marker⓪*bhi notag⓪*subi #'0',d0 ;'0'=Untergrenze abziehen⓪*blt notag⓪*lsl #2,d0 ;in der Tabelle stehen LONGs⓪*lea tags,a0⓪*move.l ptr,0(a0,d0.w)⓪"notag⓪"END⓪ END SetTag;⓪ ⓪ (*$l-*)⓪ PROCEDURE GotoLine (l:LONGCARD;col:CARDINAL);⓪ BEGIN⓪"ASSEMBLER⓪(move.l ptr,scrPtr⓪(move.l ptrStart,a0⓪(move.w -(a3),d2⓪(move.l -(a3),d1⓪(beq asgn⓪ lp subq.l #1,d1⓪(beq asgn⓪(jsr NextCR⓪(bra lp⓪ asgn tst.b (a0)⓪(beq pre0⓪(addq.l #1,a0 ; DLE überspringen⓪(move.b (a0)+,d1⓪(subi.b #DLEoffset,d1⓪(sub.b d1,d2⓪(bmi set0⓪(adda.w d2,a0⓪ set0 move.l a0,ptr⓪ ext0 jmp CenterScreen⓪ pre0 jsr LastCR⓪(addq.l #3,a0 ; hinter DLE⓪(bra ext0⓪"END⓪ END GotoLine;⓪ ⓪ (*$l-*)⓪ PROCEDURE Jump; (* Setzen des Text-Pointers *)⓪ BEGIN⓪ ASSEMBLER⓪(move.l rptf,d1⓪(bne.l count⓪(END; PutCmd('Jump: B(egin, E(nd, L(ast or tag '); ASSEMBLER⓪(jsr ReadUpCh⓪(move ptrCount,workCount⓪(move.l ptr,scrPtr⓪ jmplp move.l ptr,a0⓪(cmpi.b #'L',d0⓪(bne nolast⓪(move.l lastPtr,a0⓪(bra nomar1⓪ nolast cmpi.b #'E',d0⓪(bne noend⓪(move.l ptrEnd,a0⓪(subq.l #2,a0⓪(bra nomar1⓪ noend cmpi.b #'B',d0⓪(bne nobeg⓪(move.l ptrStart,a0⓪ nomar1 bra.l nomark⓪ nobeg cmpi.b #' ',d0⓪(bne nospc⓪(jsr ReadUpCh⓪(move.l ptr,a0⓪(bra.l nosyn⓪ nospc lea ptrStack,A1⓪(move workCount,d1⓪(cmpi.b #'+',d0⓪(bne noplus⓪(addq #4,d1⓪(bra bckpls⓪ noplus cmpi.b #'-',d0⓪(bne noback⓪(subq #4,d1⓪ bckpls andi #$3C,d1⓪(move.l 0(A1,d1.w),a0⓪(move d1,workCount⓪(bsr.l nomark⓪(jsr ReadUpCh⓪(cmpi.b #'-',d0⓪(beq nospc⓪(bra jmplp⓪ noback cmpi.b #'?',d0⓪(bne nosyn⓪(tst.l ErrorPos⓪(beq nosyn⓪(END; PutCmd(ErrMsg); ASSEMBLER⓪(tst saved⓪(bne syn1⓪(lea tags,A1⓪(move.l $3C(A1),a0⓪(bra syn2⓪ syn1 move.l ptrStart,a0⓪(adda.l ErrorPos,a0⓪(lea tags,A1⓪(move.l a0,$3C(A1)⓪ syn2 bsr nomark⓪(jmp ErrorWait⓪ nosyn cmpi.b #'Z',d0⓪(bhi nomark⓪(subi.b #'0',d0⓪(bcs nomark⓪(asl #2,d0⓪(lea tags,A1⓪(move.l 0(A1,d0.w),a0⓪ nomark cmpa.l ptrStart,a0⓪(bcs bad⓪(cmpa.l ptrEnd,a0⓪(bcc bad⓪(bra asgn⓪ count move.l d1,(a3)+⓪(clr (a3)+⓪(jmp gotoLine⓪ asgn move.l a0,ptr⓪ bad move.l #CenterScreen,(a3)+⓪(jmp CondScreen⓪ END⓪ END Jump;⓪ ⓪ (*$l+*)⓪ PROCEDURE WriteTitle;⓪"BEGIN⓪$writestring ('Gepard-Atari Editor '+Version+' for Megamax Modula-2'); WriteLn;⓪$writestring⓪$('Copyright © [1985..1995], Thomas Tempelmann, Türkenstr. 31, 80799 München');⓪$writeLn;⓪$writeLn⓪"END WriteTitle;⓪ ⓪ PROCEDURE UpdatePath (VAR tPath: ARRAY OF CHAR);⓪"VAR res: INTEGER;⓪"BEGIN⓪$MakeFullPath (tPath, res);⓪$ConcatPath (tPath, Path1, Path1);⓪"END UpdatePath;⓪ ⓪ PROCEDURE Getpath (VAR tPath: String);⓪"BEGIN⓪$GetDefaultPath(tPath);⓪$Append('*.*',tPath,strOk);⓪"END GetPath;⓪L(*Hü*)⓪ FORWARD SetDepth (r: LONGCARD);⓪ ⓪ PROCEDURE getFilefromBox (title: MaxStr): String;⓪"VAR selectOK,Ok :Boolean;⓪&REST,TEMPPATH,fName: STRING;⓪"BEGIN⓪$IF UseGem THEN⓪&Write(ClrScrnChar);⓪&IF GEMVersion () <= $120 THEN⓪(GotoXY ( (cols-Length(title)) DIV 2, 1);⓪(WriteString (title);⓪&END;⓪&IF isMac THEN SetDepth (oldDepth); END;⓪&SelectFile(title,Path1,FName1,selectOK);⓪&IF isMac THEN SetDepth(1) END;⓪&Write(ClrScrnChar);⓪&SplitPath(Path1,tempPath,Rest);⓪&abort:= NOT selectOK OR Empty (FName1);⓪&IF NOT abort then⓪(Concat(tempPath,FName1,fName,Ok);⓪(if Ok then return fName end⓪&END;⓪&Return ''⓪$ELSE⓪&WriteString (title);⓪&Write (' ');⓪&ReadString (fName);⓪&IF Empty (fName) THEN abort:= TRUE END;⓪&IF Abort THEN fName:= '' END;⓪&RETURN fName⓪$END;⓪!END getFilefromBox;⓪ ⓪ PROCEDURE NewFile; (* neues File laden *)⓪"VAR fn:STRING;⓪ BEGIN⓪"ClrKBDbuffer;⓪"ClrCmdLine;⓪"IF NOT saved & Worthy() THEN⓪$WriteString('New file: Throw away changes ? ');⓪$IF NOT Yes() THEN GoToPtr; RETURN END⓪"END;⓪"GotoXY(0,0); Write(ClrEOLnchar);⓪"fn:=getFilefromBox('Load which file?');⓪"IF ChkName(fn) THEN⓪$SearchFile (fn,SrcPaths,fromStart,strok,fn);⓪$Open (f,fn,readOnly);⓪$IOResult:=State(f);⓪$IF SuccessFull(13) THEN⓪&UpdatePath (fn);⓪&WriteString('Reading ');WriteString(fn);WriteLn;⓪&flen:= FileSize(f);⓪&ReadText;⓪$END;⓪$IF IOResult=0 THEN Flip(fileName,fn) END⓪"END;⓪"jumpPtr (tags[';']);⓪"tags[';']:= ptrEnd⓪ END NewFile;⓪ ⓪ (*$l+*)⓪ PROCEDURE CopyText; (* einkopieren eines Files oder des Buffers *)⓪"VAR copyname:STRING; tagDisplace:LONGINT;⓪ BEGIN⓪"PutCmd('Copy: B(uffer');⓪"ReadUpCh;⓪"IF ch='B' THEN⓪$BufferToText(true); PushPtr; ScreenOut⓪"END⓪ END CopyText;⓪ ⓪ (*$l-*)⓪ PROCEDURE FiReDefault; (* Defaultwerte fⁿr Find/Replace *)⓪ BEGIN⓪ ASSEMBLER⓪(tst.l rptf⓪(bne nodflt⓪(tst infinite⓪(bne nodflt⓪(move #1,verify⓪(move #1,infinite⓪ nodflt jmp ClrCmdLine⓪ END⓪ END FiReDefault;⓪ ⓪ (*$l+*)⓪ PROCEDURE Prompt(ps:STRING; id1:STRING; VAR inp1:STRING);⓪ BEGIN (* Prompt für Find/Replace *)⓪"ASSEMBLER⓪$jsr PutDir⓪$moveq #'(',d0⓪$jsr ChrOut⓪$moveq #'?',d0⓪$tst verify⓪$beq inf⓪$jsr ChrOut⓪ inf⓪$tst infinite⓪$beq inf1⓪$moveq #'/',d0⓪$jsr ChrOut⓪$bra inf2⓪ inf1⓪$move.l rptf,(a3)+⓪$jsr WriteLCard⓪ inf2⓪$moveq #')',d0⓪$jsr ChrOut⓪$moveq #' ',d0⓪$jsr ChrOut⓪"END;⓪"WriteString(ps);⓪"IF findWord THEN WriteString(' Word') END;⓪"WriteString(id1);⓪"WriteString(': ');⓪"ReadString(inp1)⓪ END Prompt;⓪ ⓪ (*$l+*)⓪ PROCEDURE ConvToST (VAR s:ARRAY OF CHAR);⓪"VAR i,n:CARDINAL;⓪"BEGIN⓪$n:=ORD(s[0]);⓪$FOR i:=1 TO n DO⓪&s[i-1]:=s[i]⓪$END;⓪$s[n]:=0C⓪"END ConvToST;⓪ ⓪ (*$l+*)⓪ PROCEDURE ConvToGep (VAR s:ARRAY OF CHAR);⓪"VAR i,n:CARDINAL;⓪"BEGIN⓪$n:=Length(s);⓪$FOR i:=n TO 1 BY -1 DO⓪&s[i]:=s[i-1]⓪$END;⓪$s[0]:=CHR(n)⓪"END ConvToGep;⓪ ⓪ (*$l+*)⓪ PROCEDURE Find; (* oldString suchen *)⓪ VAR s: String;⓪ BEGIN⓪"FiReDefault;⓪"IF NOT findSame THEN Prompt('Find','',oldString) END;⓪"GoToPtr;⓪"IF NOT abort & (Length(oldString)>0) THEN⓪$scrPtr:=ptr;⓪$ConvToGep (oldString);⓪$LOOP⓪&IF Search() THEN⓪(IF verify THEN⓪*CenterScreen;⓪*PutCmd('Find: /SPACE/ to proceed, any key to end');⓪*ReadCh;IF ch#' ' THEN EXIT END⓪(END;⓪(ASSEMBLER move.l rptf,d0 tst infinite beq decr addq.l #2,d0⓪(decr subq.l #1,d0 move.l d0,rptf bne goOn END; EXIT; ASSEMBLER⓪(!goOn⓪(END⓪&ELSE⓪(CondScreen(CenterScreen);⓪(Concat(CardToStr(rptf,0),' Find: string not found',s,strok);⓪(PutCmd(s);⓪(ErrorWait; EXIT⓪&END⓪$END;⓪$ConvToST (oldString);⓪$CondScreen(CenterScreen)⓪"END⓪ END Find;⓪ ⓪ (*$l-*)⓪ PROCEDURE Look;⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪ fndna cmpi.b #DLEchar,-2(a0)⓪(beq Lookit⓪(move.b -1(a0),d0⓪(beq Lookit⓪(jsr AlphaNum⓪(bne Lookit⓪(subq.l #1,a0⓪(bra fndna⓪ Lookit lea oldString,A1⓪(moveq #0,d6⓪ Looklp move.b (a0)+,d0⓪(move.b d0,d1⓪(jsr AlphaNum ;d1 bleibt erhalten⓪(bne ex⓪(move.b d1,0(A1,d6.w)⓪(clr.b 1(A1,d6.w)⓪(addq.b #1,d6⓪(cmpi #79,d6⓪(bcs Looklp⓪(subq.b #1,d6⓪ ex tst.b d6⓪(beq noLook⓪(JSR PushPtr ; für Rücksprung mit J-⓪(move.l ptr,a0⓪(tst findSame⓪(bne fnd⓪(move #1,findSame⓪(move.l ptrStart,a0⓪(tst direction⓪(beq fnd⓪(move.l ptrEnd,a0⓪(subq.l #2,a0⓪ fnd move.l a0,ptr⓪(jmp Find⓪ noLook⓪ END⓪ END Look;⓪ ⓪ (*$l+*)⓪ PROCEDURE FReplace; (* oldString suchen und durch newString erstzen *)⓪"VAR tagDisplace:LONGINT; s: String;⓪ BEGIN⓪"FiReDefault;⓪"IF NOT findSame THEN⓪$Prompt('Replace',' old',oldString);⓪$IF NOT abort & (Length(oldString)>0) THEN Home;⓪&Prompt('Replace',' new',newString)⓪$END⓪"END;⓪"GoToPtr;⓪"IF NOT abort & (Length(oldString)>0) THEN⓪$tagDisplace:=LONG (INTEGER(Length(newString)-Length(oldString)));⓪$scrPtr:=ptr;⓪$ConvToGep (oldString);⓪$LOOP⓪&IF Search() THEN⓪(IF verify THEN⓪*CenterScreen;⓪*PutCmd('Replace: /SPACE/ replaces, /RETURN/ skips, /ESC/ ends');⓪*REPEAT ReadCh UNTIL (ch=' ') OR (ch=EnterKey) OR abort⓪(ELSE⓪*Home;WriteLCard(rptf);⓪*IF KeyPressed() THEN ChrIn END⓪(END;⓪(IF abort THEN EXIT END;⓪(IF NOT verify OR (ch=' ') THEN⓪*IF Available(SHORT(tagDisplace)) THEN⓪,IF direction THEN⓪.MoveText(delPtr,tagDisplace); FillIn(ptr,newString)⓪,ELSE⓪.MoveText(ptr,tagDisplace); FillIn(delPtr,newString);⓪.ASSEMBLER move.l tagDisplace(A6),d0 add.l d0,ptr END⓪,END;⓪,PushPtr;⓪,ASSEMBLER move.l rptf,d0 tst infinite beq decr addq.l #2,d0⓪,decr subq.l #1,d0 move.l d0,rptf bne goOn END; EXIT; ASSEMBLER⓪,!goOn⓪,END⓪*ELSE⓪,CondScreen(CenterScreen);⓪,PutCmd('Replace: Out of memory');ErrorWait; EXIT⓪*END⓪(END⓪&ELSE⓪(CondScreen(CenterScreen);⓪(Concat(CardToStr(rptf,0),' Replace: string not found',s,strok);⓪(PutCmd(s);⓪(ErrorWait; EXIT⓪&END⓪$END;⓪$ConvToST (oldString);⓪$CondScreen(CenterScreen)⓪"END⓪ END FReplace;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE ScreenTop: ADDRESS;⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0 ;aktueller Ptr⓪(move ptrLine,d1 ;aktuelle Zeile⓪ pcr cmp maxLine,d1 ;bis in letzte Bildschirmzeile vorpirschen⓪(bhi zcr⓪(jsr NextCR ;setzt A0 auf nächstes CR+1⓪(addq #1,d1⓪(bra pcr⓪ zcr subq #1,d1⓪(beq korr⓪(jsr LastCR ;wieder zurⁿck, damit Bildschirm immer voll⓪(bra zcr⓪ korr move.l a0,(a3)+⓪ END⓪ END ScreenTop;⓪ ⓪ PROCEDURE ScreenTop1: ADDRESS; (* geht nur nach oben, sonst Fehler bei *)⓪ BEGIN (* Mausaktion auf letzter Seite (Hü) *)⓪ ASSEMBLER⓪(move.l ptr,a0 ;aktueller Ptr⓪(move ptrLine,d1 ;aktuelle Zeile⓪(beq zero⓪ subl subq #1,d1⓪(beq zero⓪(jsr LastCR ;ein CR zurück⓪(bra subl⓪ zero move.l a0,(a3)+⓪ END⓪ END ScreenTop1;⓪ ⓪ PROCEDURE ScreenTop2: ADDRESS;⓪"BEGIN⓪$ASSEMBLER⓪(jsr screentop1⓪(move.l -(a3),a0⓪(jsr lineSt⓪(move.l a0,(a3)+⓪$END⓪"END ScreenTop2;⓪ ⓪ PROCEDURE ScreenBottom: ADDRESS;⓪ BEGIN⓪ ASSEMBLER⓪(move.l ptr,a0⓪(move ptrLine,d1⓪ pcr cmp maxLine,d1 ;bis in letzte Bildschirmzeile vorpirschen⓪(bhi zcr0⓪(jsr NextCR⓪(addq #1,d1⓪(bra pcr⓪ zcr0 move.l a0,(a3)+⓪ END⓪ END ScreenBottom;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE HardCopyFromTo(a,b:ADDRESS; fwd:BOOLEAN);⓪"PROCEDURE timeOut;⓪$BEGIN⓪&PutCmd ('Printer: Timeout');Bell;ErrorWait;⓪$END timeOut;⓪"BEGIN⓪$ASSEMBLER⓪(MOVEM.L D3/D4/A4/A5,-(A7)⓪(MOVE -(A3),D3⓪(MOVE.L -(A3),A5⓪(MOVE.L -(A3),A4⓪(MOVEQ #CRChar,D0⓪(BRA print⓪ ⓪&get⓪(TST D3⓪(BNE forw⓪(CMPA.L A4,A5⓪(BLS noget⓪(MOVE.B -(A5),D0⓪(RTS⓪&forw⓪(CMPA.L A5,A4⓪(BCC noget⓪(MOVE.B (A4)+,D0⓪(RTS⓪&noget⓪(CLR D0⓪(RTS⓪ ⓪&prn⓪(MOVE.W D0,-(A7)⓪(MOVE #5,-(A7)⓪(TRAP #1⓪(ADDQ.L #4,A7⓪(TST.W D0⓪(RTS⓪ ⓪&again⓪(JSR KeyPressed⓪(TST -(A3)⓪(BEQ nokey⓪(JSR GetKeyD0⓪(CMPI.B #EscKey,D0⓪(BEQ ende⓪&noKey⓪(BSR get⓪(BEQ ende⓪(CMPI.B #CRChar,D0⓪(BNE nocr⓪(BSR prn⓪(BEQ timeout0⓪(MOVEQ #LFChar,D0⓪(BRA print⓪&nocr⓪(CMPI.B #DLEChar,D0⓪(BNE print⓪(BSR get⓪(BEQ ende⓪(SUBI.B #' ',D0⓪(BCS again⓪(CLR D4⓪(MOVE.B D0,D4⓪(BRA pdle⓪&ldle⓪(MOVEQ #' ',D0⓪(BSR prn⓪(BEQ timeout0⓪&pdle⓪(DBRA D4,ldle⓪(BRA again⓪&print⓪(BSR prn⓪(BNE again⓪&timeout0⓪(BSR timeOut⓪(BRA ret⓪&ende⓪(MOVEQ #CRChar,D0⓪(BSR prn⓪(BEQ ret⓪(MOVEQ #LFChar,D0⓪(BSR prn⓪&ret⓪(MOVEM.L (A7)+,D3/D4/A4/A5⓪$END⓪"END HardCopyFromTo;⓪ ⓪ (*$l+*)⓪ PROCEDURE HardCopy;⓪ BEGIN⓪"PutCmd('HardCopy: S(creen, B(uffer, A(ll');⓪"ReadUpCh;⓪"IF ch='S' THEN HardCopyFromTo(ScreenTop2(),ScreenBottom(),true)⓪"ELSIF ch='B' THEN HardCopyFromTo(bufferL,bufferH,false)⓪"ELSIF ch='A' THEN HardCopyFromTo(ptrStart,ptrEnd,true)⓪"END⓪ END HardCopy;⓪ ⓪ PROCEDURE wrNotSaved;⓪"BEGIN⓪$WriteString('Last changes have not been saved yet!')⓪"END wrNotSaved;⓪ ⓪ (*$l+*)⓪ PROCEDURE Environment;⓪"PROCEDURE OnOff(x:BOOLEAN);⓪"(*$l-*)⓪"BEGIN⓪$ASSEMBLER tst -(a3) bne on moveq #'f',d0 jsr ChrOut bra on1⓪$on moveq #'n',d0 on1 jsr ChrOut jmp WriteLn⓪$END⓪"END OnOff;⓪"(*$l+*)⓪"VAR sTime:STRING; tabString:String; i:CARDINAL; tg: CHAR;⓪ BEGIN⓪"LOOP⓪$Write(ClrScrnChar);⓪$writeTitle;⓪$IF NOT saved THEN⓪&wrNotSaved;⓪$ELSE⓪&WriteString ("Editor's internal version: ");⓪&WriteString (intVersion);⓪$END;⓪$WriteLn;⓪$WriteLn;⓪$WriteString('Filename: ');WriteString(fileName); WriteLn;⓪$WriteString(' last update: '); DateToText (UnpackDate (fileD), '', sTime); WriteString(sTime);⓪$WriteString(' / '); TimeToText (UnpackTime (fileT), '', sTime); WriteString(sTime); WriteLn;⓪$IF restoreFileDT THEN⓪&WriteString (' last code: '); WriteString (CodeName); WriteString (', '); WriteString (CardToStr (Codesize,0)); WriteString (' bytes'); WriteLn;⓪$END;⓪$WriteLn;⓪$WriteString('O(ld: ');WriteString(oldString);WriteLn;⓪$WriteString('N(ew: ');WriteString(newString);WriteLn;⓪$WriteString('F(lip Old and New');WriteLn;⓪$WriteLn;⓪$WriteString('A(uto backup is o'); OnOff(autoBack);⓪$WriteString('C(ase sensitivity is o'); OnOff(findCase);⓪$WriteString('I(ncrement version is o'); OnOff(autoIncVer);⓪$WriteString('Q(uick save & load is o'); OnOff(leaveDLEonWrite);⓪$WriteString('S(ave <Editor-Info-Line> is o'); OnOff(saveInfo);⓪$WriteLn;⓪$WriteString('Tags: ');⓪$FOR tg:='0' TO 'Z' DO⓪&IF (ptrStart<tags[tg]) & (tags[tg]<ptrEnd) THEN⓪(Write(tg)⓪&ELSE⓪(Write(' ')⓪&END⓪$END;⓪$WriteLn;⓪$WriteLn;⓪$WriteString('T(ab setting'); WriteLn;⓪$tabString:=TabsToStr(); WriteString(tabString); WriteLn;⓪$WriteLn;⓪$WriteString('Enter option: '); ReadUpCh; WriteLn;⓪$IF ch='A' THEN Negate(autoBack)⓪$ELSIF ch='C' THEN Negate(findCase)⓪$ELSIF ch='F' THEN Flip(oldString,newString)⓪$ELSIF ch='I' THEN Negate(autoIncVer)⓪$ELSIF ch='Q' THEN Negate(leaveDLEonWrite)⓪$ELSIF ch='S' THEN Negate(saveInfo)⓪$ELSIF ch='N' THEN WriteString('New: ');ReadString(newString)⓪$ELSIF ch='O' THEN WriteString('Old: ');ReadString(oldString)⓪$ELSIF ch='T' THEN ReadString(tabString);GetTabs(tabString);⓪$ELSIF ch='X' THEN⓪&makeDLE:=FALSE; CleanText; makeDLE:=TRUE; CleanText;⓪&ChkLastPtr; ptr:= ptrStart; CenterScreen⓪$ELSE EXIT⓪$END⓪"END;⓪"ScreenOut;⓪"cmdFlag:=false⓪ END Environment;⓪ ⓪ ⓪ FORWARD CloseTextFrame;⓪ ⓪ (*$l+*)⓪ PROCEDURE QuitEditor; (* Q(uit- Untermenⁿ *)⓪"VAR fn:STRING; show,sWarn:BOOLEAN; p:CARDINAL;⓪ BEGIN⓪"ClrKBDbuffer;⓪"fn:= '';⓪"cmdFlag:=false;⓪"show:=true; sWarn:=false;⓪"Write(ClrScrnChar);⓪"LOOP⓪$IF show THEN⓪&GotoXY(0,0);⓪&IF saveinfo THEN WriteString('Editor Info-Line will be saved') END;⓪&ClrLn;⓪&IF leaveDLEonWrite THEN WriteString('Quick save is active') END;⓪&ClrLn;⓪&ClrLn;⓪&IF NOT saved AND Worthy() THEN⓪(wrNotSaved⓪&END;⓪&ClrLn;⓪&ClrLn;⓪&WriteString ('Filename: '); WriteString (fileName); ClrLn;⓪&ClrLn;⓪&WriteString('E(xit'); ClrLn;⓪&WriteString('I(ncrement'); ClrLn;⓪&WriteString ('U(pdate (Save & Exit)'); ClrLn;⓪&IF filesInMem=0 THEN⓪(WriteString('C(ompile (Update & Compile)'); ClrLn;⓪(WriteString('X(exute (Execute)'); ClrLn;⓪(WriteString('M(ake (Update & Make)'); ClrLn;⓪(WriteString('R(un (Make & Execute)'); ClrLn;⓪&END;⓪&WriteString('S(ave'); ClrLn;⓪&WriteString('B(ack up and save'); ClrLn;⓪&WriteString('K(eep time stamp and save'); ClrLn;⓪&WriteString('W(rite to a file...'); ClrLn;⓪&WriteString('N(ew filename...'); ClrLn;⓪&WriteString('O(ther filename, no save...'); ClrLn;⓪&WriteString('ESC to return'); ClrLn;⓪&show:=false⓪$END;⓪$GoToXY(0,21);⓪$ReadUpCh; IF ch> ' ' THEN Write(ch) END;⓪$Write(ClrEOSchar);⓪$IF (ch=ESCkey) OR (ch=EnterKey) THEN EXIT⓪$ELSIF ch='I' THEN WriteString (IncrementVersion())⓪$ELSIF ch='E' THEN⓪&saved:=saved OR NOT Worthy();⓪&IF NOT saved THEN WriteLn;⓪(WriteString('Throw away changes since last update? ');⓪(saved:=Yes()⓪&END;⓪&IF saved THEN⓪(IF filesInMem=0 THEN endOfEd:=true ELSE CloseTextFrame END;⓪(EXIT⓪&END⓪$ELSIF ch='W' THEN WriteLn;⓪&(* WriteString('Write file: '); ReadString(fn); *)⓪&fn:=getFilefromBox('Write file:');⓪&show:=true;⓪&IF NOT abort & ChkName(fn) & SaveText(fn,false,true,false) THEN END⓪$ELSIF ch='O' THEN WriteLn;⓪&(* WriteString('Other filename: '); ReadString(fn); *)⓪&fn:=getFilefromBox('Other filename:');⓪&show:=true;⓪&IF NOT abort & ChkName(fn) THEN⓪(Flip(fn,fileName); sWarn:=true⓪&END⓪$ELSIF ch='N' THEN WriteLn;⓪&(* WriteString('New filename: '); ReadString(fn); *)⓪&fn:=getFilefromBox('New filename:');⓪&show:=true;⓪&IF NOT abort & ChkName(fn) & SaveText(fn,false,true,false) THEN⓪(Assign (fn,TextName,strok);⓪(Flip(fn,fileName);⓪&END⓪$ELSIF Length(fileName)>0 THEN⓪&IF (ch='S') OR (ch='K') THEN⓪(IF SaveText(fileName,false,sWarn,ch='K') THEN⓪*Assign (filename,TextName,strok);⓪(END⓪&ELSIF (ch='U')⓪&OR (⓪((filesInMem=0) & ( (ch='C') OR (ch='X') OR (ch='M') OR (ch='R') )⓪&) THEN⓪(IF SaveText(fileName,false,sWarn,false) THEN⓪*Assign (filename,TextName,strok);⓪*IF filesInMem=0 THEN⓪,endOfEd:=true;⓪,IF ch='C' THEN⓪.exitCode:= 1⓪,ELSIF ch='X' THEN⓪.exitCode:= 2⓪,ELSIF ch='M' THEN⓪.exitCode:= 3⓪,ELSIF ch='R' THEN⓪.exitCode:= 4⓪,END⓪*ELSE⓪,CloseTextFrame⓪*END;⓪*EXIT⓪(END⓪&ELSIF ch='B' THEN⓪(IF SaveText(fileName,true,false,false) THEN⓪*Assign (filename,TextName,strok);⓪(END⓪&END⓪$END⓪"END;⓪"IF NOT endOfEd THEN⓪$IF ~makeDLE THEN⓪&makeDLE:= True;⓪&WriteLn;⓪&WriteString ('please wait...');⓪&Cleantext;⓪$END;⓪$ScreenOut⓪"END⓪ END QuitEditor;⓪ ⓪ (*$l+*)⓪ PROCEDURE OpenTextFrame;⓪ BEGIN⓪"IF (bufferL-ptrEnd<1500L) THEN⓪$PutCmd('Not enough memory for text-frame'); Bell; ErrorWait⓪"ELSE⓪$ASSEMBLER⓪,jsr finish⓪,move.l ptrEnd,d0⓪,addq.l #3,d0⓪,bclr #0,d0⓪,move.l d0,a0⓪,move.l total,(a0)+⓪,move direction,(a0)+⓪,move saved,(a0)+⓪,move saveinfo,(a0)+⓪,move makeDLE,(a0)+⓪,move leaveDLEonWrite,(a0)+⓪,move findCase,(a0)+⓪,move autoBack,(a0)+⓪,move autoIncVer,(a0)+⓪,move.l errorpos,(a0)+⓪,lea ptrStack,A1⓪,moveq #58,d0⓪$allptr move.l (A1)+,(a0)+⓪,dbf d0,allptr⓪,lea filename,A1⓪,moveq #40,d0⓪$allfn move (A1)+,(a0)+⓪,dbf d0,allfn⓪,lea tabs,A1⓪,moveq #40,d0⓪$alltab move (A1)+,(a0)+⓪,dbf d0,alltab⓪,move nrOfTabs,(a0)+⓪,move ptrLine,(a0)+⓪,move ptrCount,(a0)+⓪,move fileD,(a0)+⓪,move fileT,(a0)+⓪,move restoreFileDT,(a0)+⓪,move.l ptr,(a0)+⓪,move.l lastPtr,(a0)+⓪,move.l ptrStart,(a0)+⓪,move.l ptrEnd,(a0)+⓪,clr (a0)+⓪,⓪,addq #1,filesInMem⓪,move.l a0,ptrStart⓪,move.b #DLEchar,(a0)+⓪,move.b #DLEoffset,(a0)+⓪,move.l a0,ptr⓪,move.l a0,lastPtr⓪,clr (a0)+⓪,move.l a0,ptrEnd⓪,clr.l (a0)+⓪,moveq #58,d0 lea ptrStack,a0 lp clr.l (a0)+ dbf d0,lp⓪,jsr ResetTextOptions⓪,clr.b fileName⓪,clr delFlag clr insFlag clr.l total⓪,jsr Prepare⓪,move.l d0,startupTime clr.l errorpos⓪,move #1,ptrLine jsr ScreenOut⓪$END⓪"END⓪ END OpenTextFrame;⓪ ⓪ (*$l+*)⓪ PROCEDURE CloseTextFrame;⓪ BEGIN⓪"saved:=saved OR NOT Worthy();⓪"IF filesInMem=0 THEN⓪$PutCmd('No old text frame to close'); Errorwait; RETURN⓪"ELSIF NOT saved THEN⓪$ClrCmdLine;⓪$WriteString('Close text frame: Throw away changes ? ');⓪$IF NOT Yes() THEN GoToPtr; RETURN END⓪"END;⓪"ASSEMBLER⓪*move.l ptrStart,a0⓪*subq.l #2,a0⓪*move.l -(a0),ptrEnd⓪*move.l -(a0),ptrStart⓪*move.l -(a0),lastPtr⓪*move.l -(a0),ptr⓪*move -(a0),restoreFileDT⓪*move -(a0),fileT⓪*move -(a0),fileD⓪*move -(a0),ptrCount⓪*move -(a0),ptrLine⓪*move -(a0),nrOfTabs⓪*moveq #40,d0⓪*lea tabs,A1⓪*lea 82(A1),A1⓪"alltab move -(a0),-(A1)⓪*dbf d0,alltab⓪*moveq #40,d0⓪*lea filename,A1⓪*lea 82(A1),A1⓪"allfn move -(a0),-(A1)⓪*dbf d0,allfn⓪*moveq #58,d0⓪*lea ptrStack,A1⓪*lea 236(A1),A1⓪"allptr move.l -(a0),-(A1)⓪*dbf d0,allptr⓪*move.l -(a0),errorpos⓪*move -(a0),autoIncVer⓪*move -(a0),autoBack⓪*move -(a0),findCase⓪*move -(a0),leaveDLEonWrite⓪*move -(a0),makeDLE⓪*move -(a0),saveinfo⓪*move -(a0),saved⓪*move -(a0),direction⓪*move.l -(a0),total⓪*jsr Prepare⓪*move.l d0,startupTime⓪*subq #1,filesInMem⓪"END⓪ END CloseTextFrame;⓪ ⓪ ⓪ (*$? mayCallCompiler:⓪ ⓪ TYPE⓪(Header = RECORD⓪3LayoutNr : BYTE;⓪3Id : BYTE;⓪3QualificationFlag : CARDINAL;⓪3Key : LONGCARD;⓪3OffsExTree : ADDRESS;⓪3DefinedItems : CARDINAL;⓪3OffsImpList : ADDRESS;⓪3VarSize : LONGCARD;⓪3ModName : ADDRESS⓪1END;⓪ ⓪(⓪(TreeEntry = RECORD⓪6OffsNextItemNr: CARDINAL;⓪6Name: CHAR⓪4END;⓪ ⓪ (*$L-*)⓪ PROCEDURE CompName (ad: ADDRESS): MaxStr;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A0⓪(MOVE.L A3,A2⓪(LEA 256(A3),A3⓪"CopyHelpStr⓪(MOVE.B (A0)+,D0⓪(BEQ EndCopy⓪(CMPI.B #$FE,D0⓪(BCC EndCopy⓪(MOVE.B D0,(A2)+⓪(BRA CopyHelpStr⓪"EndCopy⓪(CLR.B (A2)+⓪$END⓪"END CompName;⓪ ⓪ VAR defFile: File; size: LONGCARD;⓪$returnVal: BOOLEAN;⓪ ⓪ (*$L+*)⓪ PROCEDURE Process;⓪ ⓪"VAR str: POINTER TO ARRAY [0..7] OF CHAR;⓪&first, continue, success: BOOLEAN;⓪&Data: POINTER TO Header;⓪&helpString: String;⓪&BytesRead: LONGCARD;⓪&modName: ADDRESS;⓪ ⓪ BEGIN⓪"(* Process File *)⓪"Home;⓪"IF (bufferL - ptrEnd < size + 1500L) THEN⓪$WriteString ('Insufficient memory!');⓪$ReadCh;⓪$returnVal:= FALSE;⓪$RETURN⓪"END;⓪"Data:= ptrEnd + 4L; (* leave some bytes unused for security resons *)⓪"ReadBytes (defFile, Data, size, BytesRead);⓪"IF BytesRead # size THEN⓪$(* if not all bytes read exit *)⓪$WriteString ('Read error!');⓪$ReadCh;⓪$returnVal:= TRUE;⓪$RETURN⓪"END;⓪"str:= ADDRESS (Data);⓪"INC (Data,8);⓪"IF (Compare (str^, "MM2Code") # equal) OR (Data^.ID # BYTE (3)) THEN⓪$(* not a DEF file *)⓪$returnVal:= TRUE;⓪$RETURN⓪"END;⓪"(* display modname *)⓪"modName:= ADDRESS(Data)+Data^.ModName;⓪"WriteString (CompName (modName));⓪"continue:= TRUE; (* default: scan next file *)⓪"first:= TRUE; (* first check the modname itself *)⓪"(* scan list of exported items *)⓪"ASSEMBLER⓪(; Cursorpos. merken⓪(move ptrY,d0⓪(move.b ptrX,d0⓪(move d0,yx⓪(MOVE.L modName(A6),A1⓪(BRA.W searchStart⓪(⓪"CaseSen⓪(; put next character of item-name in D0 and next of oldString in D1,⓪(; increment index.⓪(MOVE.B 0(A1,D2.W),D0⓪(MOVE.B 0(A2,D2.W),D1⓪(ADDQ.W #1,D2⓪(RTS⓪"NoCaseSen⓪(; same as CaseSen, but characters are converted to capitals.⓪(CLR D0⓪(MOVE.B 0(A2,D2.W),D0⓪(MOVE.B 0(A4,D0.W),D0⓪(MOVE.W D0,D1⓪(MOVE.B 0(A1,D2.W),D0⓪(MOVE.B 0(A4,D0.W),D0⓪(ADDQ.W #1,D2⓪(RTS⓪"⓪"ItemFound⓪(BSR.W showItem⓪(BNE CmpFailed⓪"endOfTree⓪(RTS⓪(⓪"CompNext⓪(MOVE.W (A0)+,D0 ; modul-lokale Item-Nr⓪(BEQ.L endOfTree⓪(LEA 2(A0),A1⓪"CompFirst⓪(MOVEQ #0,D2 ; D2 := index in strings⓪"CmpNext⓪(JSR (A5) ; get next characters in D0/D1⓪(TST.B D0⓪(BEQ.W ItemEnd⓪(CMP.B #$FE,D0 ; check end of item-name⓪(BCC.W ItemEnd ; end of name⓪(CMP.B D0,D1⓪(BEQ CmpNext ; equal -> continue with next⓪(TST.B D1⓪(BNE CmpFailed⓪(TST.W findWord⓪(BNE CmpFailed⓪(BRA.W ItemFound⓪"ItemEnd⓪(; End of name of item is reached. if also end of oldString ->⓪(; item is correct.⓪(TST.B D1⓪(BEQ.W ItemFound⓪"CmpFailed⓪(; skip to next item and continue search⓪(TST.W first(A6)⓪(BEQ notFirst⓪(CLR.W first(A6)⓪(MOVE.L Data(A6),A0 ; A0 := pointer to header⓪(MOVE.L Header.OffsExTree(A0),D0 ; D0 := offset to list of items⓪(BEQ.L endOfTree ; no exported items⓪(ADDA.L D0,A0 ; A0 := pointer to list of items⓪(BRA CompNext⓪"notFirst⓪(ADDQ.B #1,D0⓪(BEQ endOfName⓪(ADDA.W D2,A1⓪"luup2 MOVE.B (A1)+,D0⓪(BPL luup2⓪(ADDQ.B #1,D0⓪(BNE luup2⓪"endOfName⓪(CMPI.B #13,1(A1)⓪(BNE noRecord⓪(⓪(; lokalen Record-Baum durchsuchen⓪(MOVE.L A0,-(A7)⓪(LEA 8(A1),A0⓪(BSR CompNext⓪(MOVE.L (A7)+,A0⓪(TST continue(A6)⓪(BEQ endOfTree⓪(⓪"noRecord⓪(MOVE.W TreeEntry.OffsNextItemNr(A0),D0 ; offset to next item⓪(BEQ.L endOfTree⓪(ADDA.W D0,A0⓪(BRA CompNext⓪(⓪"writeName⓪(LEA helpString(A6),A2⓪(CLR D1⓪"CopyHelpStr⓪(MOVE.B (A1)+,D0⓪(BEQ EndCopy⓪(CMPI.B #$FE,D0⓪(BCC EndCopy⓪(ADDQ #1,D1⓪(MOVE.B D0,(A2)+⓪(BRA CopyHelpStr⓪"EndCopy⓪(CLR.B (A2)+⓪(MOVE.B #'.',D0⓪(JSR ChrOut ; write '.'⓪(LEA helpString(A6),A2⓪(MOVE.L A2,(A3)+⓪(MOVE.W D1,(A3)+⓪(JMP BufferWrite ; write helpString⓪"⓪"wrn ; Namen auf Stack rückwärts ausgeben⓪(MOVE.L 4(A0),D0⓪(BEQ wrn3⓪(MOVE.L A1,-(A7)⓪(MOVE.L D0,A1⓪(ADDQ.L #2,A1⓪(ADDQ.L #8,A0⓪(BSR wrn⓪(MOVE.L (A7)+,A1⓪"wrn3 BRA writeName⓪ ⓪ ⓪"showItem⓪(; search successful⓪(MOVEM.L A0/A2/A5,-(A7)⓪(TST.W first(A6)⓪(BNE NoNam⓪(LEA 16(A7),A0⓪(BSR wrn⓪"NoNam JSR Bell⓪(MOVE.B #' ',D0⓪(JSR ChrOut ; write ' '⓪(MOVE.B #'?',D0⓪(JSR ChrOut ; write '?'⓪(JSR ReadCh ; get input⓪(TST abort⓪(BNE FindEnd ; ESC -> abort⓪(TST accept⓪(BNE FindEnd ; F1 -> load⓪(MOVE.B ch,D0⓪(CMPI.B #EnterKey,D0⓪(BEQ FindEnd⓪(JSR ShiftUp ; convert to capitals⓪(CMPI.B #'Y',D0⓪(BNE ContSearch⓪"FindEnd⓪(; User wants to load this def.-module⓪(CLR continue(A6)⓪"ContSearch⓪(MOVE yx,d1⓪(JSR GotoXYd1⓪(MOVEQ #ClrEOLNchar,d0⓪(JSR ChrOut⓪(MOVEM.L (A7)+,A0/A2/A5⓪(TST continue(A6)⓪(RTS⓪ ⓪"searchStart⓪(MOVE.L A4,-(A7)⓪(MOVE.L A5,-(A7) ; save A5⓪(LEA ShiftTab,A4⓪(LEA NoCaseSen(PC),A5⓪(TST.W findCase⓪(BEQ StartSearch2 ; not case sensitive⓪(LEA CaseSen(PC),A5⓪"StartSearch2⓪(LEA oldString,A2 ; A2 := pointer to oldString⓪(CLR.L -(A7)⓪(BSR CompFirst⓪(ADDQ.L #4,A7⓪(MOVE.L (A7)+,A5 ; restore A5⓪(MOVE.L (A7)+,A4⓪"END;⓪"IF ~continue & ~abort THEN⓪$modNameFound:= first;⓪$oldString:= helpString;⓪$defFound:= TRUE⓪"END;⓪"returnVal:= continue⓪ END Process;⓪ ⓪ PROCEDURE ProcessDefFile (defFile0: File; size0: LONGCARD): BOOLEAN;⓪"VAR exc:Exception;⓪"BEGIN⓪$defFile:= defFile0;⓪$size:= size0;⓪$Call (Process, exc);⓪$RETURN returnVal⓪"END ProcessDefFile;⓪ ⓪ (*$L+*)⓪ PROCEDURE ProcessDefFile1 (REF path : ARRAY OF CHAR; entry : DirEntry): BOOLEAN;⓪"VAR name: ARRAY [0..139] OF CHAR;⓪&f: File;⓪&cont: BOOLEAN;⓪"BEGIN⓪$Assign (path, name, success);⓪$Append (entry.name, name, success);⓪$Open (f, name, readOnly);⓪$cont:= ProcessDefFile (f, entry.size);⓪$IF defFound THEN Assign (entry.name, filename, success) END;⓪$Close (f);⓪$RETURN cont⓪"END ProcessDefFile1;⓪ ⓪ (*$L+*)⓪ PROCEDURE ProcessDefFile2 (entry : LibEntry) : BOOLEAN;⓪"VAR cont: BOOLEAN;⓪"BEGIN⓪$Seek (DefLibFile.f, entry.start, fromBegin);⓪$cont:= ProcessDefFile (DefLibFile.f, entry.size);⓪$IF defFound THEN Assign (entry.name, filename, success) END;⓪$RETURN cont⓪"END ProcessDefFile2;⓪ ⓪ (*$L+*)⓪ PROCEDURE FindDefinition;⓪ ⓪ VAR⓪(Entry : PathEntry;⓪(wild : ARRAY [1..141] OF CHAR;⓪(b2, success : BOOLEAN;⓪(result : INTEGER;⓪ ⓪ BEGIN⓪"IF (bufferL-ptrEnd<1500L) THEN⓪$PutCmd('Not enough memory for this function'); Bell; ErrorWait; RETURN⓪"END;⓪"(* determine identifier to be searched *)⓪"ASSEMBLER⓪(; code is copied from procedure look and modified⓪(move.l ptr,a0⓪ fndna cmpi.b #DLEchar,-2(a0) ; is it start of line ?⓪(beq Lookit ; yes -> start of word found⓪(move.b -1(a0),d0 ; get previous character⓪(beq Lookit ; if it's zero -> start of word found⓪(jsr AlphaNum⓪(bne Lookit ; if it's no alphanum. -> start found⓪(subq.l #1,a0 ; search backwards⓪(bra fndna⓪ Lookit⓪(; now copy whole word into oldString⓪(lea oldString,A1 ; A1 := pointer to oldString⓪(moveq #0,d6 ; length of copied word⓪ Looklp move.b (a0)+,d0 ; get one char⓪(move.b d0,d1 ; save char⓪(jsr AlphaNum ;d1 bleibt erhalten⓪(bne ex ; if it's not alphanum. -> word copied⓪(move.b d1,0(A1,d6.w) ; put char⓪(clr.b 1(A1,d6.w) ; clear next byte⓪(addq.b #1,d6 ; inc. length⓪(cmpi #79,d6⓪(bcs Looklp ; repeat until 80 characters copied⓪(subq.b #1,d6 ; dec. length⓪ ex tst.b d6⓪(beq.l noLook ; if length = 0 -> no search⓪"END;⓪"success:= findCase;⓪"b2:= findWord;⓪"OpenTextFrame;⓪"findCase:= success;⓪"findWord:= b2;⓪"(* all memory between ptrEnd and bufferL can now be used *)⓪"defFound:= FALSE;⓪"⓪"(* Query Def-Libfile *)⓪"Assign (DefLibName, wild, success);⓪"ReplaceHome (wild);⓪"OpenLib (DefLibFile, wild, result);⓪"IF result >= 0 THEN⓪$LibQuery (DefLibFile, ProcessDefFile2, result);⓪$CloseLib (DefLibFile)⓪"END;⓪"⓪"(* Query normal .DEF files *)⓪"IF NOT defFound THEN⓪$ResetList (DefPaths);⓪$LOOP⓪&Entry:= NextEntry (DefPaths);⓪&IF (Entry = NIL) OR defFound OR abort THEN EXIT END;⓪&(* Process Entry *)⓪&Concat (Entry^, '*.', wild, success);⓪&Append (DefSfx, wild, success);⓪&ReplaceHome (wild);⓪&DirQuery (wild, FileAttrSet{}, ProcessDefFile1, result);⓪$END;⓪"END;⓪ ⓪"IF defFound THEN⓪$ASSEMBLER⓪(; change extension from .def to .d⓪(LEA filename,A0 ; A0 := pointer to filename⓪"TestOneChar⓪(MOVE.B (A0)+,D0 ; get one char from name⓪(CMPI.B #'.',D0⓪(BNE TestOneChar ; repeat until '.' found⓪(CLR.B 1(A0) ; terminate string after 'D'⓪$END;⓪$Write(ClrScrnchar);⓪$SearchFile (filename,SrcPaths,fromStart,success,filename); (* Search⓪csource *)⓪$success:= findCase;⓪$Open (f,filename,readOnly);⓪$IOResult:=State(f);⓪$IF SuccessFull(13) THEN⓪&WriteString('Reading ');WriteString(filename);WriteLn;⓪&flen:= FileSize(f);⓪&ReadText⓪$END;⓪$findCase:= success;⓪$IF IOResult#0 THEN⓪&CloseTextFrame;⓪&cmdFlag:= FALSE;⓪&ScreenOut⓪$ELSE⓪&(* file is read. Now set Cursor *)⓪&ScreenOut;⓪&IF NOT modNameFound THEN⓪(findWord:= TRUE;⓪(findSame:= TRUE;⓪(findCase:= TRUE;⓪(Find⓪&END⓪$END⓪"ELSE⓪$(* Kein File gefunden *)⓪$CloseTextFrame;⓪$ScreenOut;⓪$cmdFlag:=false;⓪"END;⓪"ASSEMBLER⓪ noLook⓪"END;⓪ END FindDefinition;⓪ *)⓪ ⓪ (*$L+*)⓪ (*$? mayCallCompiler:⓪ PROCEDURE callCompiler;⓪"VAR ok: BOOLEAN; ex: INTEGER; msg: ARRAY [0..125] OF CHAR;⓪&res: LoaderResults; l, l2: LONGINT;⓪&ad: ADDRESS; tim, dat: CARDINAL; p: POINTER TO CHAR;⓪&oldSize: LONGCARD; str: Strings.String;⓪"BEGIN⓪$(*⓪%* Puffer bis auf 1000 Byte freien Rest verkleinern⓪%*)⓪$l:= LONGINT (bufferH-ptrEnd-1000L); (* Länge des freien Puffers *)⓪$IF l>0L THEN⓪&IF NOT FullStorBaseAccess () THEN⓪((* wenn kein Vergrößern des Speichers am Ende möglich,⓪)* dann geben wir hier nur 2/3 des noch freien Speichers frei. *)⓪(l2:= AllAvail();⓪(IF l2 >= 2 * l THEN⓪*l:= 0⓪(ELSIF l2 >= l THEN⓪*l:= l DIV 3;⓪(ELSE⓪*l:= l - l DIV 3;⓪(END⓪&END;⓪&IF l > 0 THEN⓪(IF ODD (l) THEN DEC (l) END;⓪(DEALLOCATE (bufferStart, l);⓪(bufferH:= bufferStart + MemSize (bufferStart);⓪(ASSEMBLER⓪*MOVE.L bufferH,D0⓪*BCLR #0,D0⓪*MOVE.L D0,A0⓪*CLR.L -(A0)⓪*CLR.L -(A0)⓪*MOVE.L A0,bufferH⓪*MOVE.L A0,bufferL⓪(END;⓪&END;⓪$END;⓪$⓪$ScanMode:= FALSE;⓪$IF autoIncVer & NOT saved THEN⓪&str:= IncrementVersion ()⓪$ELSE⓪&str:= ''⓪$END;⓪$PutCmd (conc ("Compiling... ", str));⓪$p:= ptrEnd;⓪$p^:= 3C;⓪$⓪$Concat (fileName, ' /Q /@', msg, ok);⓪$Append (LHexToStr (ptrStart,0), msg, ok);⓪$IF MainOutputPath[0] # 0C THEN⓪&Append (' /O', msg, ok);⓪&Append (MainOutputPath, msg, ok);⓪$END;⓪$IF CompilerArgs[0] # 0C THEN⓪&Append (' ', msg, ok);⓪&Append (CompilerArgs, msg, ok);⓪$END;⓪$tim:= DirTime (); dat:= Today ();⓪$oldSize:= DefaultStackSize;⓪$DefaultStackSize:= 16000;⓪$CallModule (CompilerParm.name, StdPaths, msg, NIL, ex, str, res);⓪$DefaultStackSize:= oldSize;⓪$p^:= 0C;⓪$IF Inconsistent () THEN⓪&Bell; PutCmd ("Memory management is damaged! Save text with backup and reboot!"); ErrorWait⓪$END;⓪$IF res # noError THEN⓪&Bell; PutCmd (conc ("Compiler couldn't be executed: ", str)); ErrorWait⓪$ELSE⓪&CASE ex OF⓪(0: restoreFileDT:= TRUE; fileD:= dat; fileT:= tim;⓪-ScreenOut|⓪(2,3: Assign (ErrorMsg, ErrMsg, ok);⓪-GotoLine (TextLine, TextCol-1);⓪-tags['?']:= ptr;⓪-ErrorPos:= ptr-ptrStart;⓪-Bell; PutCmd(ErrMsg); ErrorWait |⓪(4: ScreenOut; Bell; PutCmd('Include files are not allowed here!'); ErrorWait |⓪&ELSE⓪-ScreenOut; Bell; GetStateMsg (ex, str); PutCmd(str); ErrorWait⓪&END⓪$END;⓪$ad:= bufferStart;⓪$IF (l>0L) & FullStorBaseAccess () THEN⓪&Enlarge (bufferStart, l, ok);⓪&IF ~ok THEN⓪(bufferStart:= ad (* wird anscheinend vom Storage zerstört?! *);⓪(Bell;⓪(PutCmd ("Editor's buffer is nearly full. You'd better save the text and quit/reboot!");⓪(ErrorWait⓪&ELSE⓪(bufferH:= bufferStart + MemSize (bufferStart);⓪(ASSEMBLER⓪*MOVE.L bufferH,D0⓪*LSR #1,D0⓪*LSL #1,D0⓪*MOVE.L D0,A0⓪*CLR.L -(A0)⓪*CLR.L -(A0)⓪*MOVE.L A0,bufferH⓪*MOVE.L A0,bufferL⓪(END⓪&END⓪$END;⓪"END callCompiler;⓪ *)⓪ ⓪ (*$L-*)⓪ PROCEDURE Supexec ( p : PROC );⓪ BEGIN⓪ ASSEMBLER⓪(MOVE.L -(A3),-(A7)⓪(MOVE #38,-(A7)⓪(TRAP #14⓪(ADDQ.L #6,A7⓪ END⓪ END Supexec;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE mode_mac;⓪ BEGIN⓪ ASSEMBLER⓪*dc.w $4ef0,$01e1,$00f0 ; jmp ([$F0])⓪ END⓪ END mode_mac;⓪ ⓪ (*$L-*)⓪ PROCEDURE mode_atari;⓪ BEGIN⓪ ASSEMBLER⓪*dc.w $4ef0,$01e1,$00f4 ; jmp ([$F4])⓪ END⓪ END mode_atari;⓪ ⓪ (*$L-*)⓪ PROCEDURE GetDepth (): LONGCARD;⓪ BEGIN⓪ ASSEMBLER⓪*clr.l -(a7)⓪*move #32,-(a7)⓪*trap #1 ; Super(0)⓪*move.l d0,2(a7)⓪*jsr mode_mac⓪*move.l a5,-(a7)⓪*move.l $904,A5⓪*SUBQ.L #4,A7⓪*DC.W $AA2A ; _GetMainDevice⓪*MOVE.L (A7),A0⓪*SUBQ.L #2,A7⓪*move.l a0,-(a7)⓪*clr.w -(a7)⓪*DC.W $AA2C ; _TestDeviceAttribute (dev, 0)⓪*clr d0⓪*MOVE.B (A7)+,d0⓪*swap d0⓪*MOVE.L (A7)+,A0⓪*MOVE.L (A0),A0⓪*MOVE.L 22(A0),A0⓪*MOVE.L (A0),A0⓪*MOVE.W 32(a0),D0 ; pixelSize⓪*move.l (a7)+,a5⓪*jsr mode_atari⓪*move.l d0,(a3)+⓪*trap #1 ; Super(0)⓪*addq.l #6,a7⓪ END⓪ END GetDepth;⓪ ⓪ (*$L-*)⓪ PROCEDURE SetDepth (r: LONGCARD);⓪ BEGIN⓪ ASSEMBLER⓪*clr.l -(a7)⓪*move #32,-(a7)⓪*trap #1 ; Super(0)⓪*move.l d0,2(a7)⓪*JSR mode_mac⓪*move.l d1,-(a7)⓪*move.l -(a3),d1⓪*move.l a5,-(a7)⓪*move.l $904,A5⓪*SUBQ.L #6,A7⓪*DC.W $AA2A ; _GetMainDevice⓪*move.w d1,-(a7)⓪*move.w #1,-(a7)⓪*swap d1⓪*move.w d1,-(a7)⓪*move.w #$0A13,D0⓪*DC.W $AAA2 ; _SetDepth⓪*MOVE.w (A7)+,d0⓪*move.l (a7)+,a5⓪*move.l (a7)+,d1⓪*jsr mode_atari⓪*trap #1 ; Super(0)⓪*addq.l #6,a7⓪"END⓪ END SetDepth;⓪ ⓪ (*$L-*)⓪ PROCEDURE Setrez (r: CARDINAL);⓪ BEGIN⓪ ASSEMBLER⓪(MOVE.W -(A3),-(A7)⓪(MOVEQ #-1,D0⓪(MOVE.L D0,-(A7)⓪(MOVE.L D0,-(A7)⓪(MOVE #5,-(A7)⓪(TRAP #14⓪(ADDA.W #12,A7⓪ END⓪ END Setrez;⓪ ⓪ (*$L-*)⓪ PROCEDURE Getrez (): CARDINAL;⓪ BEGIN⓪ ASSEMBLER⓪(MOVE #4,-(A7)⓪(TRAP #14⓪(ADDQ.L #2,A7⓪(MOVE.W D0,(A3)+⓪ END⓪ END Getrez;⓪ ⓪ (*$L-*)⓪ PROCEDURE SetColor (n,c: CARDINAL): CARDINAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),-(A7)⓪(MOVE #7,-(A7)⓪(TRAP #14⓪(ADDQ.L #6,A7⓪(MOVE.W D0,(A3)+⓪$END;⓪"END SetColor;⓪"⓪ (*$L-*)⓪ PROCEDURE Wvbl;⓪ BEGIN⓪ ASSEMBLER⓪(LEA $FF8200,A1⓪(MOVEP.W 1(A1),D0⓪(NOP⓪(NOP⓪ W1 MOVEP.W 5(A1),D1⓪(CMP.W D0,D1⓪(BEQ W1⓪ W2 MOVEP.W 5(A1),D1⓪(CMP.W D0,D1⓪(BNE W2⓪ END⓪ END Wvbl;⓪ ⓪ (*$L-*)⓪ PROCEDURE initFont8_8;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L pFont8_8,A0⓪(; Daten in Font-Puffer kopieren, dabei umverteilen⓪(LEA fontbuffer,A1⓪(MOVE.W #255,D0⓪ l: MOVEQ #7,D1⓪(CLR D2⓪ m: MOVE.B 0(A0,D2.W),(A1)+⓪(ADDI.W #$100,D2⓪(DBRA D1,m⓪(ADDQ.L #1,A0⓪(DBRA D0,l⓪$END;⓪"END initFont8_8;⓪ ⓪ (*$L-*)⓪ PROCEDURE initFont8_16;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L pFont8_16,A0⓪(LEA fontbuffer,A1⓪(MOVE.W #255,D0⓪ n: MOVEQ #15,D1⓪(CLR D2⓪ o: MOVE.B 0(A0,D2.W),(A1)+⓪(ADDI.W #$100,D2⓪(DBRA D1,o⓪(ADDQ.L #1,A0⓪(DBRA D0,n⓪$END;⓪"END initFont8_16;⓪ ⓪ (*$L-*)⓪ PROCEDURE GetpScreen;⓪ BEGIN⓪"ASSEMBLER⓪(; zuerst dafür sorgen, daß wir die shift-bits bei bconin bekommen.⓪(MOVE.B $484,oldconterm⓪(BSET #3,$484⓪(MOVE.L $44E,pScreen⓪ ⓪((*⓪(MOVE SR,-(A7)⓪(MOVE #$2700,SR⓪(JSR Wvbl⓪(CLR D1⓪(LEA $FF8260,A2⓪(TST isTT ; bei TT immer auf 640*400⓪(BEQ noTT⓪(ADDQ.L #2,A2⓪ noTT MOVE.L A2,ColorReg⓪(MOVE.B (A2),D0⓪(ANDI #7,D0⓪(MOVE.B D0,oldShiftMode⓪(TST isTT ; bei TT immer auf 640*400⓪(BNE doTT⓪(BTST #1,D0⓪(SEQ D1⓪(MOVE.W D1,color⓪(BEQ mono⓪(BTST #0,D0⓪(SNE D1⓪(MOVE.W D1,UseGEM ; falls Auflösung gewechselt, kein GEM verw.⓪(BSET #0,$FF8260⓪(JSR initFont8_8⓪(BRA ende⓪ doTT CMPI.B #2,oldShiftMode⓪(BEQ mono⓪(CLR UseGEM ; falls Auflösung gewechselt, kein GEM verw.⓪(MOVE.B (A2),D0⓪(ANDI #$F8,D0⓪(OR.B #2,D0⓪(MOVE.B D0,(A2)⓪(BRA mono2⓪ mono: MOVE #1,UseGEM⓪(; Daten in Font-Puffer kopieren, dabei umverteilen⓪ mono2 JSR initFont8_16⓪ ende MOVE (A7)+,SR⓪(*)⓪"END⓪ END GetpScreen;⓪ ⓪ (*$L-*)⓪ PROCEDURE ResetpScreen;⓪ BEGIN⓪ ASSEMBLER⓪((*⓪(; auf VBL warten⓪(MOVE SR,-(A7)⓪(MOVE #$2700,SR⓪(JSR Wvbl⓪(MOVE.L ColorReg,A2⓪(MOVE.B (A2),D0⓪(ANDI #$F8,D0⓪(OR.B oldShiftMode,D0⓪(MOVE.B D0,(A2)⓪(MOVE (A7)+,SR⓪(*)⓪(MOVE.B oldconterm,$484⓪ END⓪ END ResetpScreen;⓪ ⓪ (*$L+*)⓪ ⓪ PROCEDURE OscanIs () : BOOLEAN;⓪"VAR oScan : CARDINAL;⓪ BEGIN⓪"ASSEMBLER⓪$MOVE.W #4200,-(SP)⓪$TRAP #14⓪$ADDQ.L #2,SP⓪$MOVE.W D0,oScan(A6)⓪"END;⓪"RETURN oScan # 4200⓪ END OscanIs;⓪ ⓪ PROCEDURE OscanSwitch (mode : INTEGER) : INTEGER;⓪"VAR oScanMode : INTEGER;⓪ BEGIN⓪"ASSEMBLER⓪$MOVE.W mode(A6),-(SP)⓪$MOVE.W #4206,-(SP)⓪$TRAP #14⓪$ADDQ.L #4,SP⓪$MOVE.W D0,oScanMode(A6)⓪"END;⓪"RETURN oScanMode⓪ END OscanSwitch;⓪ ⓪ (*$L-*)⓪ PROCEDURE EsetShift (shftMode: WORD): CARDINAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W -(A3),-(A7)⓪(MOVE #80,-(A7)⓪(TRAP #14⓪(ADDQ.L #4,A7⓪(MOVE.W D0,(A3)+⓪$END⓪"END EsetShift;⓪ ⓪ (*$L-*)⓪ PROCEDURE EgetShift (): CARDINAL;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE #81,-(A7)⓪(TRAP #14⓪(ADDQ.L #2,A7⓪(MOVE.W D0,(A3)+⓪$END⓪"END EgetShift;⓪ ⓪ ⓪ TYPE Rect = RECORD⓪(top, left, bottom, right: CARDINAL;⓪ END;⓪ ⓪ TYPE PixMap = RECORD⓪(baseAddr: ADDRESS;⓪(rowBytes: CARDINAL;⓪(bounds: Rect;⓪ END;⓪ ⓪ TYPE PtrPixMap = POINTER TO PixMap;⓪ ⓪ TYPE MgMcCookie = RECORD⓪(vers: CARDINAL;⓪(size: CARDINAL;⓪(flags1: LONGCARD;⓪(scrnPMPtr: PtrPixMap;⓪(updatePalette: POINTER TO BYTE;⓪(modeMac: PROC;⓪(modeAtari: PROC;⓪(getBaseMode: PROC;⓪(getIntrCount: PROC;⓪(intrLock: PROC;⓪(intrUnlock: PROC;⓪(callMacContext: PROC;⓪(atariZeroPage: ADDRESS;⓪(macA5: ADDRESS;⓪(macAppSwitch: PROC;⓪(controlSwitch: PROC;⓪(hwAttr1: LONGCARD;⓪(hwAttr2: LONGCARD;⓪(magiC_BP: ADDRESS;⓪(auxOutName: ADDRESS;⓪(auxInName: ADDRESS;⓪(auxControl: PROC;⓪ END;⓪ ⓪ TABLE.B ColdStart: 1;⓪ ⓪ VAR oldOscan: INTEGER;⓪$pMacCookie: POINTER TO MgMcCookie;⓪ ⓪ ⓪ (*$L+,A+*)⓪ PROCEDURE InitScreen;⓪"VAR i,newShiftMode: CARDINAL; l: LONGCARD; pla: LineA.PtrNegLineAVars;⓪"BEGIN⓪$isMac:= CookieJar.GetCookie ("MgMc", pMacCookie);⓪$IF ~CookieJar.GetCookie (CookieJar.Machine, l) THEN l:= 0 END;⓪$isTT:= l >= 2;⓪$IF Oscanis() THEN oldOscan:= Oscanswitch (0); END;⓪$UseGem:= TRUE;⓪$UseMouse:= TRUE;⓪$color:= FALSE;⓪$rez_changed:= FALSE;⓪$pla:= LineA.NegLineAVariables();⓪$rowBytes:= pla^.bytesPerLine;⓪$NoOfGraphicLines:= pla^.screenHeight;⓪$NoOfTextRows:= pla^.screenWidth DIV 8;⓪$IF isMac THEN⓪&oldDepth:= GetDepth ();⓪&SetDepth (1);⓪&UseMouse:= oldDepth = 1;⓪&ASSEMBLER⓪(MOVE.L pMacCookie,A0⓪(MOVE.L pMacCookie.scrnPMPtr(A0),A0⓪(MOVE.W PixMap.rowBytes(A0),D0⓪(ANDI.W #$3FFF,D0⓪(MOVE.W D0,rowBytes⓪&END⓪$ELSIF ~isTT THEN⓪&oldShiftMode:= Getrez ();⓪&IF oldShiftMode # 2 THEN⓪(rez_changed:= TRUE;⓪(Setrez (1);⓪(oldColor[0]:= SetColor (0, $777);⓪(FOR i:= 1 TO 3 DO oldColor[i]:= SetColor (i, 0) END;⓪(color:= TRUE⓪&END;⓪$ELSE⓪&newShiftMode:= EgetShift ();⓪&ASSEMBLER⓪+MOVE.W newShiftMode(A6),D0⓪+ANDI #$F0FF,D0⓪+ORI #$0200,D0 ; 640*400 setzen⓪+MOVE.W D0,newShiftMode(A6)⓪&END;⓪&oldShiftMode:= EsetShift (newShiftMode);⓪$END;⓪$ASSEMBLER⓪(;*** ^ auf Fontdaten holen:⓪(DC.W $A000⓪(MOVE.L (A1)+,A0 ; f. System-Font 6*6 (Icon)⓪(MOVE.L (A1)+,A0 ; f. System-Font 8*8 (Farbe)⓪(LEA pFont8_8,A2⓪(MOVE.L 76(A0),(A2)⓪(MOVE.L (A1)+,A0 ; f. System-Font 8*16 (S/W)⓪(LEA pFont8_16,A2⓪(MOVE.L 76(A0),(A2)⓪$END;⓪$IF color THEN⓪&initFont8_8;⓪&HeightOfTextLine:= 8;⓪$ELSE⓪&initFont8_16;⓪&HeightOfTextLine:= 16;⓪$END;⓪$NoOfTextLines := NoOfGraphicLines DIV HeightOfTextLine;⓪$Supexec (GetpScreen);⓪"END InitScreen;⓪ ⓪ ⓪ (*$L+*)⓪ ⓪ PROCEDURE InitEditor; (* Initialisierung der Pointer und Flags *)⓪"VAR bufferLaenge: LONGINT; v, r: CARDINAL; d: Date;⓪ BEGIN⓪"PointsPerChar:= 8;⓪"IF color THEN⓪$LinesPerChar:= 8⓪"ELSE⓪$LinesPerChar:= 16⓪"END;⓪"allowed:=ASCII{' '..255C};⓪"bufferLaenge:=(INT(MemAvail())-32000) * 2 DIV 3;⓪"IF bufferLaenge > 0 THEN⓪$Allocate(bufferStart,bufferLaenge);⓪"END;⓪"IF bufferStart=NIL THEN WriteString('Not enough memory'); HALT END;⓪"ASSEMBLER⓪*move.l bufferStart,a0⓪*move.l a0,d0⓪*clr.l (a0)+⓪*move.l a0,ptrStart⓪*move.b #DLEchar,(a0)+⓪*move.b #DLEoffset,(a0)+⓪*move.l a0,ptr⓪*move.l a0,lastPtr⓪*clr (a0)+⓪*move.l a0,ptrEnd⓪*clr.l (a0)+⓪*add.l bufferLaenge(A6),d0⓪*bclr.l #0,d0⓪*move.l d0,a0⓪*clr.l -(a0)⓪*clr.l -(a0)⓪*move.l a0,bufferL⓪*move.l a0,bufferH⓪*moveq #0,d0⓪*move.w NoOfTextLines,d0⓪*move d0,lines⓪*subq #1,d0⓪*move d0,maxLine⓪*moveq #0,d0⓪*move.w NoOfTextRows,d0⓪*move d0,cols⓪*subq #1,d0⓪*move.b d0,maxCol⓪*subq #1,d0⓪*move.b d0,maxColM1⓪*⓪*clr exitCode⓪*clr endOfEd⓪*clr filesInMem⓪*clr cmdFlag⓪*clr delFlag⓪*clr insFlag⓪*jsr ResetTextOptions⓪*addq #1,sessions⓪*clr.l total⓪*jsr Prepare⓪*move.l d0,startupTime⓪*clr.b oldString⓪*clr.b newString⓪*move #30,countDefault⓪*CLR.L ShortKeyPtr⓪*CLR Inserting⓪*MOVE #1,errorNr⓪ ⓪*; Warmstart-Init geht nur, wenn die betroffenen Variablen als⓪*; TABLEs definiert werden (so auch die Find/Rpl-Strings).⓪*; tst.b ColdStart⓪*; beq.l warm⓪*; clr.b ColdStart⓪ ⓪*move #1,sessions⓪*clr cmdMode⓪*clr tabMode⓪*clr.l keepTime⓪"warm⓪"END⓪ END InitEditor;⓪ ⓪ (*$l+*)⓪ PROCEDURE StopEditor;⓪ VAR i: CARDINAL;⓪ BEGIN⓪"DeAllocate(bufferStart,0L);⓪"Finish;⓪"Supexec (ResetpScreen);⓪"IF isMac THEN⓪$SetDepth (oldDepth);⓪$pMacCookie^.updatePalette^:= BYTE (1);⓪$SetNewDesk (NIL, Root);⓪$ForceDeskRedraw;⓪"ELSIF isTT THEN⓪$oldShiftMode:= EsetShift (oldShiftMode);⓪"ELSE⓪$IF rez_changed THEN Setrez (oldShiftMode) END;⓪$IF color THEN⓪&FOR i:= 0 TO 3 DO dumCard:= SetColor (i, oldColor[i]) END;⓪$END;⓪"END;⓪"IF Oscanis() THEN oldOscan:= Oscanswitch (oldOscan) END;⓪"SelectFile:= FileSelectProc (oldSelect);⓪"GrafMouse (mouseOn, NIL);⓪"MouseControl (FALSE);⓪"ForceDeskRedraw;⓪"ExitGem (hdl);⓪ END StopEditor;⓪ ⓪ ⓪ VAR first: boolean; argv:ARRAY [0..4] OF PtrArgStr;⓪$argc,strpos:CARDINAL; nullCh:CHAR;⓪ ⓪ ⓪ (*$l-*)⓪ PROCEDURE Right1; (* ohne DOWN am Zeilen-Ende *)⓪ BEGIN⓪ ASSEMBLER⓪(;clr forceTab⓪(move.l ptr,a0⓪ again move.b (a0)+,d0⓪(beq donix⓪(cmpi.b #CRchar,d0⓪(beq donix⓪(cmpi.b #$20,d0⓪(bcs again⓪(move.l a0,ptr⓪(move ptrY,d1⓪(move.b ptrX,d1⓪(cmp.b maxCol,d1⓪(beq donix⓪(addq.b #1,d1⓪(jmp GotoXYd1⓪ donix⓪ END⓪ END Right1;⓪ ⓪ (*$l+*)⓪ PROCEDURE ShowCmdLine;⓪"BEGIN⓪$CASE cmdMode OF⓪&0: PutCmdOrTab(⓪ 'Edit: C(py D(el E(nv F(ind I(ns J(mp N(ew Q(uit R(epl T(ag X(chg Z(ap /'⓪(+Version+'/')|⓪&1: PutCmdOrTab(⓪ 'Edit: A(djust B(reak G(lue H(ardcopy L(ook M(id O(pp P(age /'⓪(+Version+'/')|⓪&2: PutCmdOrTab(⓪ 'Edit: ?:info K:show tabs F2:set tab F3/F4: Open/Close text frame /'⓪(+Version+'/')|⓪&3: PutCmdOrTab(⓪ 'Edit: F5: Compile F6: Look for exported identifier /'⓪(+Version+'/')|⓪&4: PutCmdOrTab(⓪ 'Edit: Find/Replace/Look prefix: S(ame V(erify W(ord /'⓪(+Version+'/')|⓪$END;⓪$cmdFlag:=true⓪"END ShowCmdLine;⓪ ⓪ (*$l+*)⓪ PROCEDURE WaitForKey;⓪ ⓪"VAR maus: BOOLEAN;⓪ ⓪"PROCEDURE CursorsOn;⓪$BEGIN⓪&Write (CursorOnChar);⓪&IF UseMouse AND NOT maus THEN⓪(GrafMouse (arrow, NIL);⓪(GrafMouse (mouseOn, NIL);⓪(maus:= TRUE;⓪&END;⓪$END CursorsOn;⓪ ⓪"PROCEDURE CursorsOff;⓪$BEGIN⓪&IF UseMouse & maus THEN⓪(GrafMouse (mouseOff, NIL);⓪(maus:= FALSE;⓪&END;⓪&ScrnCurOff;⓪$END CursorsOff;⓪ ⓪"VAR⓪$i, mousePtrX, mousePtrY: CARDINAL;⓪ ⓪"BEGIN⓪$maus:= FALSE;⓪$CursorsOn;⓪$IF CmdLineAway(TRUE) THEN⓪&CursorsOff;⓪&ShowCmdLine;⓪&CursorsOn;⓪$END;⓪$LOOP⓪&(* MAUS ist hier an *)⓪&IF Keypressed() THEN⓪(IF UseMouse THEN GrafMouse (mouseOff, NIL); maus:= FALSE END;⓪(ReadUpCh;⓪(EXIT (*Taste wurde gedrückt, Byte in Ch*)⓪&ELSE (*Hü*)⓪(GetMouseState(dev,MousePoint, buttons); (*hält Ablauf nicht an *)⓪(IF (msbut1 IN buttons) THEN⓪*IF Mousepoint.y <= (LinesPerChar DIV 2) then⓪,ch:= UpKey;⓪,EXIT⓪*ElSIF Mousepoint.y > (INTEGER(Lines)*LinesPerChar-2) THEN⓪,ch:= DownKey;⓪,EXIT⓪*ELSIF (Mousepoint.y >= LinesPerChar)⓪*AND (Mousepoint.y < (INTEGER(Lines)*LinesPerChar-2)) THEN⓪,(*Maustaste gedrückt und nicht Statuszeile*)⓪,CursorsOff;⓪,Ptr:=ScreenTop1();⓪,ptrLine:= 1;⓪,ASSEMBLER⓪0MOVE #$0100,D1⓪0JSR GotoXYD1 ; x=0, y=1⓪,END;⓪,mousePtrX := Mousepoint.x DIV PointsPerChar; (* 0-79*)⓪,mousePtrY := Mousepoint.y DIV LinesPerChar; (* 1-24, Cmd-Zeile=0 *)⓪,ch:= downKey;⓪,for i:=1 to mousePtrY-1 do Down end;⓪,GotoSOln;⓪,For i:=CursorX+1 to mousePtrX do Right1 end;⓪,ClrKbdbuffer;⓪,CursorsOn;⓪*END;⓪(END (*if Maus gedrückt*)⓪&END (*IF Key ELSE mouse*)⓪$END (*LOOP, keine Taste gedrückt*);⓪$CursorsOff;⓪"END WaitForKey;⓪ ⓪ (*$l+*)⓪ BEGIN (* of Editor *)⓪"(* Screen löschen⓪$Conout (CHR(27)); Conout ('E');⓪"*)⓪"InitScreen;⓪"oldSelect:= ADDRESS (SelectFile);⓪"IF NOT UseGem THEN SelectFile:= NoSelect; END;⓪"InitGem(RC,dev,success);⓪"if success then hdl:= CurrGemHandle() end;⓪"HomePath:= ShellPath;⓪"GrafMouse (mouseOff, NIL);⓪"MouseControl (TRUE);⓪"MenuBar (NIL, FALSE);⓪"InitEditor;⓪"Write(ClrScrnChar);⓪"writeTitle;⓪"nullCh:=0C;⓪"InitArgCV (argc,argv);⓪"ErrorPos:=0L;⓪"GetPath(Path1); FName1:= '';⓪"first := TRUE;⓪"REPEAT⓪$IF first & (length(ArgV[1]^) # 0) THEN⓪&Assign (ArgV[1]^,filename,strok);⓪&splitpath(filename,Path1,FName1);⓪&IF Path1[0] = 0C THEN⓪(GetPath (Path1)⓪&ELSE⓪(Append ('*.*', Path1, strok)⓪&END⓪$ELSE⓪&(* writestring('Edit which file? ');⓪)filename := '';⓪)readstring(filename);⓪'*)⓪&filename:=getFilefromBox('Edit which file?');⓪$END;⓪$fnOK:=ChkName(fileName);⓪$IF fnOK THEN⓪&SearchFile (filename,SrcPaths,fromStart,strok,filename);⓪&Open (f,filename,readonly);⓪&IOResult:= State(f);⓪&IF IOResult >= 0 THEN⓪(UpdatePath (filename);⓪(writeLn;⓪(WriteString('Reading '); WriteString(fileName); WriteLn;⓪(flen:= FileSize(f);⓪(ReadText⓪&ELSE⓪(WriteString ('File not found !');⓪(ErrorWait⓪&END⓪$END;⓪$first := FALSE;⓪"UNTIL NOT fnOK OR (IOResult>=0);⓪"strpos:=0;⓪"ErrLine:= StrToLCard (ArgV[2]^,strpos,strok);⓪"IF fnOK & (ErrLine#0L) THEN⓪$strpos:=0;⓪$GotoLine (ErrLine, StrToCard (ArgV[3]^,strpos,strok));⓪$tags['?']:= ptr;⓪$ErrorPos:= ptr-ptrStart;⓪$Assign (argv[4]^,ErrMsg,strok);⓪$PutCmd(ErrMsg); ErrorWait⓪"ELSE⓪$jumpPtr (tags[';']);⓪$tags[';']:= ptrEnd⓪"END;⓪"REPEAT (*2*)⓪$WaitForKey; (* Mausaktionen werden allein in der Routine behandelt, *)⓪0(* außerhalb dieser Routine ist die Maus immer aus *)⓪$IF Rptfx10() OR DirKey() THEN⓪$ELSIF ch='/' THEN Negate(infinite)⓪$ELSIF ch='S' THEN Negate(findSame)⓪$ELSIF ch='V' THEN Negate(verify)⓪$ELSIF ch='W' THEN Negate(findWord)⓪$ELSE⓪&CASE ch OF⓪&'A': Adjust |⓪&'C': CopyText |⓪&'D': DelMode |⓪&'E': Environment |⓪&'F': Find |⓪&'G': Glue |⓪&'H': HardCopy |⓪&'I': Inserting := True; InsMode; Inserting := False |⓪&'J': Jump |⓪&'K': Negate(tabMode); cmdFlag:=false |⓪&'L': Look |⓪&'M': CenterScreen |⓪&'N': NewFile |⓪&'O': Page(true) |⓪&'P': Page(false) |⓪&'Q': QuitEditor |⓪&'R': FReplace |⓪&'T': SetTag |⓪&'X': Exchange |⓪&'Y': ASSEMBLER move.l rptf,d0 beq no move d0,countDefault !no END |⓪&'Z': Zap|⓪&ELSE⓪(IF ch=BreakKey THEN Break⓪((*$? mayCallCompiler:⓪(ELSIF ch=FindDefKey THEN FindDefinition⓪(*)⓪(ELSIF ch=HomeKey THEN CenterScreen⓪(ELSIF ch=INSKey THEN Inserting := True; InsMode; Inserting := False⓪(ELSIF ch=DELKey THEN DelMode⓪(ELSIF (ch=OpenFrameKey) THEN OpenTextFrame⓪(ELSIF (ch=CloseFrameKey) THEN⓪*CloseTextFrame;⓪*cmdFlag:=false;⓪*ScreenOut⓪(ELSIF ch=Helpkey THEN⓪*IF tabMode THEN tabMode:= FALSE ELSE cmdMode:= (cmdMode+1) MOD 5 END;⓪*cmdFlag:= FALSE⓪(ELSIF ch='?' THEN Info⓪(ELSIF (ch=PageDownKey) OR (ch=PageUpKey) THEN Page(ch=PageUpKey)⓪((*$? mayCallCompiler:⓪*ELSIF ch=compileKey THEN callCompiler⓪(*)⓪(ELSE⓪*RptfOK;⓪*REPEAT⓪,IF (ch=' ') OR (ch=rightKey) THEN Right⓪,ELSIF ch=EOLNkey THEN GotoEOLN⓪,ELSIF ch=SOLNkey THEN GotoSOLN⓪,ELSIF (ch=BSkey) OR (ch=leftKey) THEN Left⓪,ELSIF ch=wordLeftKey THEN WordLeft⓪,ELSIF ch=wordRightKey THEN WordRight⓪,ELSIF ch=TabRightKey THEN⓪.REPEAT⓪0Right⓪.UNTIL (OnSOLn() AND KeyPressed()) OR (ptr>=ptrEnd-2L) OR TabSet()⓪,ELSIF ch=TabLeftKey THEN⓪.REPEAT⓪0Left⓪.UNTIL (OnSOLn() AND KeyPressed()) OR (ptr<=ptrStart) OR TabSet()⓪,ELSIF ch=upKey THEN Up⓪,ELSIF ch=downKey THEN Down⓪,ELSIF ch=scrlUpKey THEN ScrollUp;⓪,ELSIF ch=scrlDownKey THEN ScrollDown;⓪,ELSIF ch=EnterKey THEN IF direction THEN Up ELSE Down END;⓪,END;⓪,DEC(rptf)⓪*UNTIL (rptf=0L) OR KeyPressed()⓪(END⓪&END;⓪&ASSEMBLER clr.l rptf clr findWord clr findSame clr infinite clr verify⓪&END⓪$END;⓪"UNTIL endOfEd (*2*);⓪"StopEditor;⓪"TermProcess (exitCode)⓪ END GEP_ED.⓪ ə (* $00015384$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$00002CD0$FF6EC528$00027C0F$FF6EC528$00007862$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528$FF6EC528Ç$00002C7CT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00006ED9$00006ED1$00006EDC$00006ED1$00002D28$FF45A568$FF45A568$00002C7C$FF45A568$00002C37$00002C99$FF45A568$00002C37$00006EFE$00006EB2$00006ED1¼üâ*)